试图操纵数据（VBA）后Excel循环挂起

我已经在VBA中编写了一个简单的嵌套for循环，循环通过我的工作表中的logging，如果它发现一些基于条件的值，复制当前工作表中的值。

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函数加速了这个过程。 我对它进行了testing，但是我不确切知道Excel工作表中的数据types – 可以上传每个工作表的标题和1-2行数据的屏幕快照，只是为了了解您的数据types有，也是logging表的结构。

无论如何，这是我得到的代码片段：

 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

谢谢大家有用的答案，我用来解决这个问题的最后一种方法是为我想要通过的数据添加一个数据透视表，然后我在数据透视表中为这个特定的数据dynamic地添加了一个filter，而不是循环通过代码的1000个logging。

然后，我通过数据透视表拿起每个相应的客户。

示例代码如下所示：

 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 

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