我在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
最佳答案
以下使用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