循环内循环的更快方法

Question

我有一个工作代码可以将大量数据从每月 sheet 复制到每天 sheet。大约有 30 列数据要复制超过 2000 行。我不知道如何加快工作速度，因为即使复制一列也需要大约 3 分钟。对于所有 30 列，我都必须这样做。每月 sheet 中的列顺序与每日 sheet 中的不同；例如。每月 sheet 列 D 可能代表每日 sheet 的列 P。如有高人能帮忙完善代码，将不胜感激

八打灵再也

Sub COPY2()


Dim i As Long, j As Long, lastrow1 As Long, Lastrow2 As Long, myname As String
Dim SWB As Workbook, TWB As Workbook, Sws As Worksheet, Tws As Worksheet
Set SWB = ActiveWorkbook
Set Sws = SWB.Sheets("SHEET1")
Windows("DAILY.xlsX").Activate
Set TWB = ActiveWorkbook
Set Tws = TWB.Sheets("Sheet1")
lastrow1 = Sws.Range("A" & Rows.Count).End(xlUp).Row
Lastrow2 = Tws.Range("A" & Rows.Count).End(xlUp).Row
Sws.Activate
For i = 2 To lastrow1

myname = Sws.Cells(i, "B").Value

Tws.Activate
For j = 2 To Lastrow2

If Tws.Cells(j, "D").Value = myname Then Tws.Cells(j, "P").Value = Sws.Cells(i, "D").Value
If Tws.Cells(j, "P").Value = Sws.Cells(i, "D").Value Then Exit For


Next j
Next i
End Sub

Answer 1

Excel 操作需要很多时间。尝试按块而不是逐个单元地访问数据。顺便说一句，激活表在测试和调试时很有用，但它会在运行应用程序上线时浪费你的时间。

试试下面的代码片段。这个概念是读取和操作数据到缓冲区，并在完成处理后一步写回 Excel，因此您可以节省数以千计的 Excel 操作。

Dim sa(), tad(), tap()

lastrow1 = sws.Range("A" & Rows.Count).End(xlUp).Row
lastrow2 = tws.Range("A" & Rows.Count).End(xlUp).Row
sws.Activate

sa = Range(sws.Cells(1, 2), sws.Cells(lastrow1, 4))     ' B:D columns
tad = Range(tws.Cells(1, "D"), tws.Cells(lastrow2, "D")) ' D column
tap = Range(tws.Cells(1, "P"), tws.Cells(lastrow2, "P")) ' P column


For i = 2 To lastrow1

    For j = 2 To lastrow2
    
         If tad(j, 1) = sa(i, 1) Then
             tap(j, 1) = sa(i, 3)
             Exit For
         End If
    
    Next j
Next i

Range(tws.Cells(1, "P"), tws.Cells(lastrow2, "P")) = tap

End Sub

循环内循环的更快方法

quicker way for loop inside loop

vba

loops

for-loop

exit