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

NumRowsNumRowSTGSales的值分别为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

最佳答案

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

10-08 13:31
查看更多