如何使用vba將多列數據從一張工作表復制並粘貼到另一張工作表

Question

我對 VBA 很陌生，我一直在嘗試開發一種工具來將兩張僅包含選定數據列的工作表合並到輸出工作表中。

我有兩張名為 RCV 和 MGT 的工作表。 兩者都有一個唯一的列，它應該匹配並將其粘貼到名稱為輸出的第三張紙上。

我嘗試從一個單元格移動到另一個單元格，但由於數據量太大，檢查每個單元格的迭代時間太長，因此需要很長時間。

RCV 表有大約 35000 行數據，MGT 表有大約 25000 行數據。

Sub Merge_Data()
Dim i, j
Dim k
Dim WS1 As Worksheet
Set WS1 = ThisWorkbook.Sheets("RCV")
Dim WS2 As Worksheet
Set WS2 = ThisWorkbook.Sheets("MGT")
Dim files As Variant
Dim LRow1 As Long
LRow1 = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Row
Dim LRow2 As Long
LRow2 = WS2.Range("A" & WS2.Rows.Count).End(xlUp).Row
k = 3
For i = 2 To LRow1
For j = 2 To LRow2

If Sheets("RCV").Cells(i, "Q").Value = Sheets("RCV").Cells(j, "AD").Value 
Then

Sheets("Output").Cells(k, "F").Value = Sheets("RCV").Cells(i, "Q").Value
Sheets("Output").Cells(k, "H").Value = Sheets("RCV").Cells(i, "R").Value
Sheets("Output").Cells(k, "A").Value = Sheets("MGT").Cells(j, "V").Value

k = k + 1
End If
Next
Next
End Sub

請幫助我如何解決這個問題。 當條件匹配時，我需要從 RCV 工作表和 MGT 工作表中復制多列（列范圍從 Q2 到 Lastrow = AD2 到 Lastrow）。

將 RCV 表和 MGT 表中的列合並后的輸出表：

Answer 1

由於您的行數遠少於 60k 左右，因此您可以使用xlFilterValues運算符利用Range對象的AutoFilter()方法，允許您過濾更多值：

Option Explicit

Sub Merge_Data()
    Dim sheet1Data As Variant

    With Worksheets("MGT") '<--| reference your worksheet "MGT"
        sheet1Data = Application.Transpose(.Range("AD2", .Cells(.Rows.Count, "AD").End(xlUp)).Value) '<--| fill an array with referenced sheet column AD values from row 2 down to last not empty one
    End With
    With Worksheets("RCV") '<--| reference your worksheet "RCV"
        With .Range("Q1", .Cells(.Rows.Count, "Q").End(xlUp)) '<--| reference referenced sheet column Q cells from row 1 (header) down to last not empty one
            .AutoFilter Field:=1, Criteria1:=sheet1Data, Operator:=xlFilterValues '<--| filter refrenced cells with sheet 2 column A values
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then ' if any match
                Dim cell As Range, k As Long
                k = 3
                For Each cell In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) ' loop through referenced range filtered cells (skipping header)
                    Worksheets("Output").Cells(k, "F").Value = Worksheets("RCV").Cells(cell.Row, "Q").Value
                    Worksheets("Output").Cells(k, "H").Value = Worksheets("RCV").Cells(cell.Row, "R").Value
                    Worksheets("Output").Cells(k, "A").Value = Worksheets("MGT").Cells(Application.Match(cell.Value2, sheet1Data, 0) + 1, "V").Value
                    k = k + 1
                Next
            End If
        End With
        .AutoFilterMode = False
    End With
End Sub

Answer 2

這將遍歷 WS1 中的每一行，並在新行中將該行中的每個單元格復制到 WS2。 有些語法可能是錯誤的，因為我沒有測試它或在我的 excel vba 編輯器中寫入。 但這是我的解決方案。

dim lastrow1 as long
dim lastrow2 as long
dim i as long
dim j as long
lastrow1 = Application.CountA(WS1.Range("A:A"))
lastrow2 = Application.CountA(WS2.Range("A:A"))

Application.ScreenUpdating = False 'not necessary but this will speed things up 

for i = 1 to lastrow1
   lastCol1 = WS1.Cells(i, Columns.Count).End(xlToLeft).Column
   'counting used columns in each row

   lastrow2 = lastrow2 + 1 'starting a new row in WS2
       for j = 1 to lastCol1
           WS2.Cells(lastrow2,j).Value = WS1.Cells(i,j).Value

       next j
next i

Application.ScreenUpdating = True 'in pair with screenupdating=false

“當列單元格值 (Q - RCV) 和列單元格值 (AD - MGT) 時，您能否讓我知道如何將工作表 1 (RCV) 和工作表 2 (MGT) 中選定的列單元格復制到工作表 3（輸出）火柴 ？ ”

這可能是一個沉重的方式。 但是當你更熟悉 vba 時，你可以讓它更快。 或者其他人稍后會給出更輕松的方法。

 'i is for WS1's rows and j is for WS2's now. col is for column count in a specific line.
dim col as long
dim rowWS3 as long
Set WS3 = ActiveWorkbook.Sheets("output")

for i = 1 to lastrow1
   for j = 1 to lastrow2
      if WS1.Cells(i,17) = WS2.Cells(j,30) 'you may add the .Value if needed
        'Q is the 17th column and Ad is the 30th. I am not sure I counted it right.

         lastCol1 = WS1.Cells(i, Columns.Count).End(xlToLeft).Column
         lastCol2 = WS2.Cells(j, Columns.Count).End(xlToLeft).Column
         rowWS3 = rowWS3 + 1
         for col = 1 to lastCol1
              WS3.Cells(rowWS3, col) = WS1.Cells(i,col)
         next col

         rowWS3 = rowWS3 + 1
        for col = 1 to lastCol2
              WS3.Cells(rowWS3, col) = WS2.Cells(j,col)
         next col
     end if
   next j
next i