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

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