当在两张纸之间找到匹配时，循环复制整行

Question

我正在尝试获取一个 For 循环，如果 ws1 中的 C 列和 ws2 中的 AT 列中的单元格匹配，它将整个行从工作表 1 复制到工作表 3。我有两个问题： 1.好像卡在For i = xxxxx循环中，没有移动到下一个k（只复制一行25次） 2. 当我在工作表 1 有 100,000 行和工作表 2 有 15,000 行的工作表上使用它时，excel 就会崩溃。有没有办法解决这个问题？

Sub CopyBetweenWorksheets()
Application.ScreenUpdating = False

Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet, myVar As String, myVar2 As String
Set ws1 = Worksheets("BOM")
Set ws2 = Worksheets("APT")
Set ws3 = Worksheets("Combined")

'get the last row for w2 and w1
ii = ws1.Cells.SpecialCells(xlCellTypeLastCell).row
kk = ws2.Cells.SpecialCells(xlCellTypeLastCell).row

For k = 2 To kk
    myVar = ws2.Cells(k, 46)
For i = 688 To ii   '688 To ii
    myVar2 = ws1.Cells(i, 3)
    If myVar2 = myVar Then
        ws3.Rows(k).EntireRow.Value = ws1.Rows(i).EntireRow.Value 'copy entire row
      Exit For
       End If
    Next i
Next k

End Sub

Answer 1

您的代码很好（没有提到缺少的Application.ScreenUpdating = True），但由于与应用程序（在本例中为 Excel）的交互量，它会挂在大量的行和列上。

每次您从 Excel 中的单个单元格请求值时，您的代码将在每 100 万次请求中挂起大约 4 秒。从整行来看，每 4000 个请求它将挂起 4 秒。如果您尝试编写单个单元格，您的代码将在每 175000 个请求中挂起 4 秒，而编写整行代码将在每 300 个请求中挂起 4 秒。

这样，只有当您尝试将 15.000 行数据从一张表解析到另一张表时，您的代码才会挂起大约 3.3 分钟.. 更不用说所有读取请求了..

因此，始终将与 vba 的任何应用程序的交互量保持在最低限度，即使您必须创建更大的代码。

如果您想处理大量数据，您的代码应该如下所示：

Sub CopyBetweenWorksheets2()
Dim aAPT, aBOM, aCombined As Variant
Dim lLastRow As Long, lLastColumn As Long
Dim i As Long, j As Long

Const APTColRef = 3
Const BOMColRef = 46
Const MAXCol = 200

'Speed up VBA in Excel
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Get the last row and column to use with the combined sheet
lLastRow = WorksheetFunction.Min(APT.Cells.SpecialCells(xlCellTypeLastCell).Row, BOM.Cells.SpecialCells(xlCellTypeLastCell).Row)
lLastColumn = WorksheetFunction.Min(MAXCol, WorksheetFunction.Max(APT.Cells.SpecialCells(xlCellTypeLastCell).Column, BOM.Cells.SpecialCells(xlCellTypeLastCell).Column))

'Parse all values to an array, reducing interactions with the application
aAPT = Range(APT.Cells(1), APT.Cells(lLastRow, lLastColumn))
aBOM = Range(BOM.Cells(1), BOM.Cells(lLastRow, lLastColumn))

'Creates a temporary array with the values to parse to the destination sheet
ReDim aCombined(1 To lLastRow, 1 To lLastColumn)

'Loop trough values and parse the row value if true
For i = 1 To lLastRow
If aAPT(i, APTColRef) = aBOM(i, BOMColRef) Then
    For j = 1 To lLastColumn
        aCombined(i, j) = aAPT(i, j)
    Next
End If
Next

'Parse values from the destination array to the combined sheet
Combined.Range(Combined.Cells(1), Combined.Cells(lLastRow, lLastColumn)) = aCombined

'Disable tweaks
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationManual
End Sub

！！我在 VBA 本身中命名了工作表对象，因此您不必声明新变量，并且以后重命名它们也不会有任何问题。所以，插入工作表（“APT”），我只是使用了 APT（如果你想让代码工作，你也必须重命名它）！！

另外，这是我为测试我的代码而编写的速度代码。我总是把它放在手边，几乎在我写的每一个函数中都会用到它

Sub Speed()
Dim i As Long
Dim dSec As Double
Dim Timer0#
Dim TimerS#
Dim TimerA#
Dim TimerB#

dSec = 4 ''Target time in secounds''
i = 1
WP1:
Timer0 = Timer
For n = 1 To i
SpeedTestA
Next
TimerA = Timer
For n = 1 To i
SpeedTestB
Next
TimerB = Timer

If TimerB - Timer0 < dSec Then
    If TimerB - Timer0 <> 0 Then
        i = CLng(i * (dSec * 2 / (TimerB - Timer0)))
        GoTo WP1
    Else
        i = i * 100
        GoTo WP1
    End If
End If
MsgBox "Código A: " & TimerA - Timer0 & vbNewLine & "Código B: " & TimerB - TimerA & vbNewLine & "Iterações: " & i
End Sub

Sub SpeedTestA() 'Fist Code

End Sub

Sub SpeedTestB() 'Secound Code

End Sub