Excel循环在尝试操作数据（VBA）后挂起

我在VBA中编写了一个简单的嵌套for循环，该循环遍历工作表中的记录，如果它根据条件找到一些值，则复制当前工作表中的值

NumRows

和

NumRowSTGSales

的值分别为4000和8000。当我运行代码时，Excel只是挂起

Dim curRowNo As Long
curRowNo = 2
NumRowSTGSales = Worksheets("Worksheet1").UsedRange.Rows.Count
' Set numrows = number of rows of data.
NumRows = Worksheets("Worksheet2").UsedRange.Rows.Count
' Select cell a1.

' Looping through GL accounts

'Looping through items in GL accounts
For y = 2 To NumRows
    'Looping through customer code found in sales data
    For z = 2 To NumRowSTGSales
        dataGL = Worksheets("Worksheet1").Cells(y, "A").Value
        dataItem = Worksheets("Worksheet1").Cells(y, "B").Value
        itemSales = Worksheets("Worksheet2").Cells(z, "F").Value
        If dataItem = itemSales Then
            dataCustomer = Worksheets("Worksheet2").Cells(z, "E").Value
            Worksheets("CurrentWorksheet").Cells(curRowNo, "A").Value = dataGL
            Worksheets("CurrentWorksheet").Cells(curRowNo, "B").Value = dataItem
            Worksheets("CurrentWorksheet").Cells(curRowNo, "C").Value = dataCustomer
            curRowNo = curRowNo + 1
        End If
    Next z
Next y

---

您在其中一行中遗漏了引号。一个快速解决方案，但可能不是问题的解决方案是在循环中添加一个“DoEvents”，以防止冻结

Dim curRowNo As Long
curRowNo = 2
NumRowSTGSales = Worksheets("Worksheet1").UsedRange.Rows.Count
' Set numrows = number of rows of data.
NumRows = Worksheets("Worksheet2").UsedRange.Rows.Count
' Select cell a1.

' Looping through GL accounts

'Looping through items in GL accounts
For y = 2 To NumRows
    'Looping through customer code found in sales data
    For Z = 2 To NumRowSTGSales
        dataGL = Worksheets("Worksheet1").cells(y, "A").Value
        dataItem = Worksheets("Worksheet1").cells(y, "B").Value
        itemSales = Worksheets("Worksheet2").cells(Z, "F").Value
        If dataItem = itemSales Then
            dataCustomer = Worksheets("Worksheet2").cells(Z, "E").Value
            Worksheets("CurrentWorksheet").cells(curRowNo, "A").Value = dataGL
            Worksheets("CurrentWorksheet").cells(curRowNo, "B").Value = dataItem
            Worksheets("CurrentWorksheet").cells(curRowNo, "C").Value = dataCustomer
            curRowNo = curRowNo + 1
        End If
    DoEvents
    Next Z
DoEvents
Next y

---

下面的代码使用了VLookup函数，大大加快了处理速度。 我对它进行了测试，但我不知道您在Excel工作表中保存的是什么类型的数据-您能否上传标题的屏幕截图和每个工作表1-2行数据，以便了解您拥有的数据类型以及记录表的结构

总之，下面是我得到的一段代码：

Sub Compare_Large_Setup()


    Dim curRowNo                            As Long

    curRowNo = 2

    NumRowSTGSales = Worksheets("Worksheet1").UsedRange.Rows.count
    ' Set numrows = number of rows of data.
    NumRows = Worksheets("Worksheet2").UsedRange.Rows.count

    Dim VlookupRange                        As Range
    Dim result                              As Variant

    ' set Range of VLookup at Worksheet2
    Set VlookupRange = Worksheets("Worksheet2").Range("F2:F" & NumRows)

    'Looping through items in GL accounts
    For y = 2 To NumRowSTGSales
        On Error Resume Next
        result = Application.WorksheetFunction.VLookup(Worksheets("Worksheet1").Cells(y, "B"), VlookupRange, 1, False)

        ' no match was found with VLlookup >> advance 1 in NEXT loop
        If Err.Number = 1004 Then
            GoTo ExitFor:
        End If

        ' successful match found with VLookup function >> copy the records to "CurrentWorksheet" sheet
        Worksheets("CurrentWorksheet").Cells(curRowNo, "A").Value = Worksheets("Worksheet1").Cells(y, "A").Value
        Worksheets("CurrentWorksheet").Cells(curRowNo, "B").Value = result
        Worksheets("CurrentWorksheet").Cells(curRowNo, "C").Value = Application.WorksheetFunction.VLookup(Worksheets("Worksheet1").Cells(y, "B"), VlookupRange, 4, False)
        curRowNo = curRowNo + 1

ExitFor:
    Next y


End Sub

---

感谢大家提供了有用的答案，我用来解决这个问题的最后一种方法是为我想要查看的数据添加一个透视表，然后在透视表中为该特定项动态添加一个过滤器，而不是通过代码循环1000条记录

然后，我通过数据透视表找到了每个对应的客户

相同的示例代码如下所示：

Dim itemCustSalesWS As Worksheet
        Set itemCustSalesWS = ActiveWorkbook.Worksheets("Sales item customer pivot")
        Dim itemCustSalesPivot As PivotTable
        Set itemCustSalesPivot = itemCustSalesWS.PivotTables("Item Customer Pivot sales")
        itemCustSalesPivot.PivotFields("Item_Code").Orientation = xlPageField
        'Filtering here
        Dim pf As PivotField
        Set pf = Worksheets("Sales item customer pivot").PivotTables("Item Customer Pivot sales").PivotFields("Item_Code")
        With pf
        .ClearAllFilters
         .CurrentPage = dataItem
         End With

         With itemCustSalesWS.UsedRange
         itemCustfirstrow = .Row
         itemCustfirstcol = .Column
         itemCustlastrow = .Rows(UBound(.Value)).Row
         itemCustlastcol = .Columns(UBound(.Value, 2)).Column
        End With

        'The following loop runs for the current filtered item FROM SEQUENCE 1 IN SALES ITEM CUSTOMER PIVOT, and maps
        'their amount  in front of the GL accounts and items
        For z = 4 To itemCustlastrow - 1

        'Logic for calculation of Sequence 4 goes here
        dataCustomer = Worksheets("Sales item customer pivot").Cells(z, "A").Value
        sumItemCust = Worksheets("Sales item customer pivot").Cells(z, "B").Value

        Worksheets("Item customer mapping").Cells(curRowNo, "A").Value = dataGL
        Worksheets("Item customer mapping").Cells(curRowNo, "B").Value = dataItem
        Worksheets("Item customer mapping").Cells(curRowNo, "C").Value = dataCustomer
        Worksheets("Item customer mapping").Cells(curRowNo, "D").Value = seq1Amount
        Worksheets("Item customer mapping").Cells(curRowNo, "E").Value = volumePerItem
        Worksheets("Item customer mapping").Cells(curRowNo, "F").Value = sumItemCust

---

感谢大家的帮助和快速响应。

您是否知道您正在使用内部循环的内部部分大约3200万次？此外，每个循环都有几个引用？当你说它挂起时，你等了多长时间才完成？按control+break和hoover键在

y

an

z

上检查它们的值，看它是否卡住或循环。最终使用F8逐步完成代码我刚刚用代码运行了一个模拟，我“仅使用”了

工作表1中的300行，以及
工作表2中的300行，完成宏需要3分钟以上（3分17秒）。因此，想象一下运行的代码包含的数据超过100倍。您需要做的是使用
Vlookup
函数，它将缩短您的运行时间，因为您不必循环整个第二个工作表。您可以做的一件事是将所有数据传输到VBA数组中，在内存中处理数组，循环完成后，将数据传回。这将涉及电子表格的4次数据传输，而不是1亿次。我在循环时使用了doEvents属性，它确实可以防止excel冻结，但在一个小时内通过3200000条记录运行，我发布的答案最终在3-4分钟内运行。