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

请帮助我解决该问题。条件匹配时（列范围从Q2到Lastrow = AD2到Lastrow），我需要从RCV工作表和MGT工作表中复制多列。

合并RCV工作表和MGT工作表中的列后的输出工作表：

Answer 1

由于行数远少于60k，因此可以使用AutoFilter()运算符利用Range对象的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）时如何将选定的列单元格从工作表1（RCV）和工作表2（MGT）复制到工作表3（输出） -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

如何使用vba

2 个答案: