如何使用vba将多列数据从一张表复制并粘贴到另一张表

Question

我对 VBA 很陌生，我一直在尝试开发一种工具来合并两张只有选定数据列的工作表以输出工作表。

我有两张名为 RCV 和 MGT 的工作表。两者都有一个应该匹配的唯一列，并将其粘贴到名为 Output 的第三张表上。

我尝试从一个单元格移动到另一个单元格，但由于数据量太大，需要很长时间，因为检查每个单元格的迭代次数太高。

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 左右，您可以利用 Range 对象的 AutoFilter() 方法和 xlFilterValues 运算符，允许您过滤更多值：

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) 匹配？"

这可能是一个沉重的方式。但是当你更熟悉 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