尝试操作数据 (VBA) 后 Excel 循环挂起

Question

我在 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

Answer 1

以下代码使用 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

Answer 2

您在其中一行中漏掉了一个引号。一个快速修复，但可能不是问题的解决方案是在循环中添加一个“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

Answer 3

感谢大家的有用回答，我用来解决这个问题的最后一种方法是为我想要通过的数据添加一个数据透视表，然后我在数据透视表中为该特定项目动态添加了一个过滤器通过代码循环遍历 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

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