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中的单个单元格请求值时，您的代码将每1百万个请求挂起约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本身中命名了sheet对象，因此您不必声明一个新变量，如果稍后重命名它们也不会有任何问题。所以，在床单（“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

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

1 个答案: