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

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

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

谢谢大家的帮助和快速回复。

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

3 个答案: