循环内循环的更快方法

Question

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

PJ

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 操作需要很长时间。尝试以块的形式访问数据，而不是逐个单元格地访问数据。 顺便说一句，激活表在测试和调试时很有用，但在实时运行应用程序时会浪费您的时间。

试试下面的 sn-p。其概念是读取和操作数据到缓冲区，并在处理完成后一步写回 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