宏需要很长时间才能循环近 700 行

Question

我试图根据映射条目（索引 i）循环近 700 行，循环 i 的每次迭代都需要很长时间（长时间循环 j）。可能是什么原因？我几乎每天都写宏，从来没有遇到过这个问题。 我也尝试只保留循环 j 中的第一行，但一直遇到这个问题

业务需求：是提取工作表中的所有列，其中列 C 包含映射表中的值（即满足此条件 PacketWork = Sheets(sheetname).Cells(j, Column3).Value 其中第 3 列是“C”

For i = 2 To lastRowLevelMapping
    PacketWork = Sheets("Mapping").Cells(i, "A").Value
    
    For j = 2 To LastRowSheet

    
    If (PacketWork = Sheets(sheetname).Cells(j, Column3).Value) Then

        Sheets("Source").Cells(writer_counter, "A").Value = Sheets(sheetname).Cells(j, Column1).Value
         
        Sheets("Source").Cells(writer_counter, "B").Value = Sheets(sheetname).Cells(j, Column2).Value
        Sheets("Source").Cells(writer_counter, "C").Value = Sheets(sheetname).Cells(j, Column3).Value
        Sheets("Source").Cells(writer_counter, "D").Value = Sheets(sheetname).Cells(j, Column4).Value
        data = Sheets(sheetname).Cells(j, Column5).Value
        If (IsNumeric(data)) Then
        Sheets("Source").Cells(writer_counter, "E").Value = Round(data, 2)
        Else
            Sheets("Source").Cells(writer_counter, "E").Value = data
        End If

         data = Sheets(sheetname).Cells(j, Column6).Value
         If (IsNumeric(data)) Then
        Sheets("Source").Cells(writer_counter, "F").Value = Round(data, 2)
        Else
             Sheets("Source").Cells(writer_counter, "F").Value = data
        End If
        data = Sheets(sheetname).Cells(j, Column7).Value

         If (IsNumeric(data)) Then
        Sheets("Source").Cells(writer_counter, "G").Value = Round(data, 2)
        Else
            Sheets("Source").Cells(writer_counter, "G").Value = data
        End If
        data = Sheets(sheetname).Cells(j, Column8).Value
         If (IsNumeric(data)) Then
        Sheets("Source").Cells(writer_counter, "H").Value = Round(data, 2)
        Else
            Sheets("Source").Cells(writer_counter, "H").Value = data
        End If
        data = Sheets(sheetname).Cells(j, Column9).Value
        If (IsNumeric(data)) Then
        Sheets("Source").Cells(writer_counter, "I").Value = Round(data, 2)
        Else
            Sheets("Source").Cells(writer_counter, "I").Value = data
        End If

       
       
        If (IsDate(Sheets(sheetname).Cells(j, Column10).Value)) Then
            Sheets("Source").Cells(writer_counter, "P").Value = Format(Sheets(sheetname).Cells(j, Column10).Value, "dd/mm/yyyy")
        Else
             Sheets("Source").Cells(writer_counter, "P").Value = Sheets(sheetname).Cells(j, Column10).Value
        End If
        Sheets("Source").Cells(writer_counter, "P").NumberFormat = "dd/mm/yyyy"
        
        If (Sheets("Source").Cells(writer_counter, "E").Value <> 0) Then


            Sheets("Source").Cells(writer_counter, "L").Value = Round((Sheets("Source").Cells(writer_counter, "F").Value / Sheets("Source").Cells(writer_counter, "E").Value) * 100, 2)
            Sheets("Source").Cells(writer_counter, "M").Value = Round((Sheets("Source").Cells(writer_counter, "G").Value / Sheets("Source").Cells(writer_counter, "E").Value) * 100, 2)

        Else

        Sheets("Source").Cells(writer_counter, "L").Value = 0
        Sheets("Source").Cells(writer_counter, "M").Value = 0

        
        End If
        

        Sheets("Source").Cells(writer_counter, "L").NumberFormat = "0.00"
        Sheets("Source").Cells(writer_counter, "M").NumberFormat = "0.00"

        If (Sheets("Source").Cells(writer_counter, "L").Value > 100) Then

            Sheets("Source").Cells(writer_counter, "L").Value = 100

        End If

        If (Sheets("Source").Cells(writer_counter, "M").Value > 100) Then

            Sheets("Source").Cells(writer_counter, "M").Value = 100

        End If

        If (Contains(Mapping2Collection, Sheets(sheetname).Cells(j, Column4).Value)) Then

                Sheets("Source").Cells(writer_counter, "N").Value = Mapping2Collection(Sheets(sheetname).Cells(j, Column4).Value)

        End If

        Sheets("Source").Cells(writer_counter, "K").Value = Sheets("Mapping").Cells(i, "D").Value
        Sheets("Source").Cells(writer_counter, "J").Value = Sheets("Mapping").Cells(i, "C").Value

        
        Sheets("Source").Cells(writer_counter, "O").Value = Sheets("Mapping").Cells(i, "B").Value
        

         
        writer_counter = writer_counter + 1
        
    


    End If
    Next j
Next i

Answer 1

将数据读入数组并用字典查找代替双循环

Option Explicit

Sub transform()
    
    Const SHT_INPUT = "sheetname"
    Const SHT_OUTPUT = "Source"
    Const SHT_MAPPING = "Mapping"

    Dim colMap ' mapping for column1 to column10
    colMap = Array(0, 1, 2, 3, 4, 5, 6, 7, 26, 25, 24)

    Dim wb As Workbook
    Dim wsIn As Worksheet, wsMap As Worksheet, wsOut As Worksheet
    Dim arMap(), arIn(), arOut()
    Dim iRowOut As Long, iLastRow As Long, iLastCol As Integer
    Dim c As Integer, i As Long, n As Long, r As Long
    Dim Mapping2Collection As New Collection

    Set wb = ThisWorkbook
    Set wsIn = wb.Sheets(SHT_INPUT)
    Set wsOut = wb.Sheets(SHT_OUTPUT)
    Set wsMap = wb.Sheets(SHT_MAPPING)

    ' build dictionary look up to sheetname column3
    Dim dict As Object, key
    Set dict = CreateObject("Scripting.Dictionary")
    iLastRow = wsIn.Cells(Rows.Count, colMap(3)).End(xlUp).Row 'last row
    iLastCol = wsIn.Cells(1, Columns.Count).End(xlToLeft).Column 'last column
    
    ' copy sheet to array then scan for values in colMap(3)
    arIn = wsIn.Range("A1").Resize(iLastRow, iLastCol).Value2
    For r = 2 To iLastRow
        key = Trim(arIn(r, colMap(3))) ' key in colMap(3)
        If dict.exists(key) Then
            MsgBox "Duplicate key '" & key & "' at row " & r, vbCritical
            Exit Sub
        Else
            dict.Add key, r
        End If
    Next
    MsgBox dict.Count & " records added to dictionary from sheet " & wsIn.Name, vbInformation

    ' copy rows on mapping sheet to array
    iLastRow = wsMap.Cells(Rows.Count, "A").End(xlUp).Row 'last row
    ReDim arMap(iLastRow - 1, 4) ' less header
    arMap = wsMap.Range("A2:D" & iLastRow)

    ' create output
    wsOut.Cells.Clear
    iRowOut = wsOut.Cells(Rows.Count, "A").End(xlUp).Row + 1 'first empty
    n = 0
    For i = 1 To UBound(arMap)
        key = arMap(i, 1) ' col A Packet Work
        Debug.Print i, key
        If dict.exists(key) Then

            ' find row on input sheet matching key
            r = dict(key)
              
            ' build row
            ReDim arOut(1 To 16) ' clear
            ' col A to I
            For c = 1 To 9
                arOut(c) = arIn(r, colMap(c))
            Next

            ' col D to I Round 2 dec if numeric
             For c = 5 To 9
                If IsNumeric(arOut(c)) Then
                    arOut(c) = Round(arOut(c), 2)
                End If
            Next

            'col J K from mappimg sheet
            arOut(10) = arMap(i, 3) ' J = map col C
            arOut(11) = arMap(i, 4) ' K = map col D

            ' col L =F/E and M=G/E % calc
            For c = 12 To 13
               If IsNumeric(arOut(5)) Then
                   If arOut(5) = 0 Then
                      arOut(c) = 0
                   Else
                      arOut(c) = Round(100 * arOut(c - 6) / arOut(5), 2)
                      If arOut(c) > 100 Then arOut(c) = 100
                   End If
               End If
            Next

            ' col N not sure what this is ?
            If contains(Mapping2Collection, arOut(4)) Then
                arOut(14) = Mapping2Collection(arOut(4))
            End If

            'col O from mapping sheet col B
            arOut(15) = arMap(i, 2) ' O = map col B

            ' col P from colMap(10) - date
            arOut(16) = arIn(r, colMap(10)) ' P

            ' format line and write out array
            With wsOut
                 .Cells(iRowOut, "L").NumberFormat = "0.00"
                 .Cells(iRowOut, "M").NumberFormat = "0.00"
                 .Cells(iRowOut, "P").NumberFormat = "dd/mm/yyyy"
                           
                ' write array values to output sheet
                 .Cells(iRowOut, 1).Resize(1, 16) = arOut
            End With
             
            ' next line
            Erase arOut
            iRowOut = iRowOut + 1
            n = n + 1
        End If
    Next
    ' end
    wsOut.Activate
    wsOut.Columns("A:P").AutoFit
    MsgBox n & " rows written to sheet" & wsOut.Name, vbInformation

End Sub

' dummy
Private Function contains(obj As Collection, val) As Boolean
    contains = False
End Function

Answer 2

我最喜欢的格言是“不要使用 Excel，使用数据”。而且您使用 Excel 进行了很多工作 - 每次迭代都会进行大量数据读取和数据输入。每个Sheet.Cells.Value = Sheet.Cells.Value 转到一个工作表、一个单元格并读取一个值，然后转到一个工作表、另一个单元格并在那里输入值；每个条件也必须读取单元格。这显然需要大量资源。

根据我的经验，如果你需要做这样的事情，数组就是答案。确定要使用的范围（Excel 对象，这会减慢您的速度），将它们加载到变体类型变量中，然后在数组中执行操作（您想要真正使用的数据，加载到内存中）然后将数组一次性插入到范围中。插图：我们在工作中碰巧在一些密集的数据操作自动化方面发生了误会，有人在复制同一个自动化项目，但我使用数组和字典完成了整个工作，而另一个人直接通过工作表引用完成了这件事。我每次执行的时间约为 30-45 秒。他们的时间是 5-6 小时。

另外，如果你多次引用同一个坐标，你真的应该把它放到一个变量中。它不仅速度更快，而且还是一种很好的编码习惯，因为当您需要修改代码时，您不需要更改尽可能多的引用并将忘记一些的风险降到最低。