データを操作しようとした後にExcelループがハングアップする

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 

Answer 2

いずれかの行に二重引用符がありませんでした。 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 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 

は、ヘルプとクイックレスポンスありがとうございました。