ExcelのVBAがサイズのためにクラッシュする

Question

VBAで "Data"シートの190,000を超える非常に長いPivot Tableを読み込み、列 "J"の値に従ってスクリプトを作成する必要があります。情報を "Temp"というシートのその行から削除します。 列 "A"の値が変更されると、 "Regioner"シートから600を超えるエントリのリストを読み込み、各値が以前の値の配列に表示されているかどうかを確認する必要があります。 私が書いたコードは動作しますが、 "Temp"シートの予想される220,000のエントリを書き留めるのは永遠に必要です。私のラップトップでは、8Gb RAMを搭載したi5第6世代では、クラッシュします。 現在のコードは以下のとおりです。 すべてに感謝します！

'Code optimization to run faster. 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

この手順を使用：このよう

Public Sub ToggleWaitMode(ByVal wait As Boolean) 
    Application.Cursor = IIf(wait, XlMousePointer.xlWait, XlMousePointer.xlDefault) 
    Application.StatusBar = IIf(wait, "Working...", False) 
    Application.Calculation = IIf(wait, XlCalculation.xlCalculationManual, XlCalculation.xlCalculationAutomatic) 
    Application.ScreenUpdating = Not wait 
    Application.EnableEvents = Not wait 
End Sub 

：代わりにこのコードはあらゆる場所に散らばったの

Public Sub FindWithoutOrder() 

Dim DataRowCounter As Long 
Dim TempRowCounter As Long 
Dim RegiRowCounter As Long 
Dim DataOldCounter As Long 
Dim DataNewCounter As Long 
Dim loopCounter As Long 
Dim DataOldProd As Range 
Dim DataNewProd As Range 
Dim DataPurchase As Range 
Dim RegiButikk As Range 
Dim ButikkFlag As Boolean 

'Code optimization to run faster. 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

'Initialize variables. 
'---------------------------------------------------------------------------------------------------------- 
DataRowCounter = 11 
TempRowCounter = 1 
DataOldCounter = 11 
DataNewCounter = 11 
Set DataOldProd = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter) 
Set DataNewProd = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter) 
Set DataPurchase = ActiveWorkbook.Sheets("Data").Range("J" & DataRowCounter) 

'Start of loop that verifies all values inside "Data" sheet. 
'---------------------------------------------------------------------------------------------------------- 
Do Until (IsEmpty(DataOldProd) And IsEmpty(DataNewProd)) 

    'Verify if the product of new line is still the same or different. 
    '------------------------------------------------------------------------------------------------------ 
    If DataNewProd.Value = DataOldProd.Value Then 
     DataNewCounter = DataNewCounter + 1 
    Else 

     'Initialize variables from "Regioner" sheet. 
     '------------------------------------------------------------------------------------------ 
     ButikkFlag = False 
     RegiRowCounter = 11 
     Set RegiButikk = ActiveWorkbook.Sheets("Regioner").Range("C" & RegiRowCounter) 

     'Verify list of supermarkets and match them with purchases list. 
     '-------------------------------------------------------------------------------------------------- 
     Do Until IsEmpty(RegiButikk) 

      'Check all supermarkets in the product range. 
      '---------------------------------------------------------------------------------------------- 
      For loopCounter = DataOldCounter To DataNewCounter - 1 

       'Compare both entries and register them if it doesn't exist in the product list. 
       '------------------------------------------------------------------------------------------ 
       If RegiButikk.Value = ActiveWorkbook.Sheets("Data").Range("D" & loopCounter).Value Then 
        ButikkFlag = True 
        RegiRowCounter = RegiRowCounter + 1 
        Set RegiButikk = ActiveWorkbook.Sheets("Regioner").Range("C" & RegiRowCounter) 
        Exit For 
       Else 
        ButikkFlag = False 
       End If 

      Next loopCounter 

      'Add to list supermarkets not present in the purchases list. 
      '------------------------------------------------------------------------------------------ 
      If ButikkFlag = False Then 
       ActiveWorkbook.Sheets("Temp").Range("B" & TempRowCounter & ":D" & TempRowCounter).Value = ActiveWorkbook.Sheets("Regioner").Range("A" & RegiRowCounter & ":C" & RegiRowCounter).Value 
       ActiveWorkbook.Sheets("Temp").Range("A" & TempRowCounter).Value = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter - 1).Value 
       TempRowCounter = TempRowCounter + 1 
       RegiRowCounter = RegiRowCounter + 1 
       Set RegiButikk = ActiveWorkbook.Sheets("Regioner").Range("C" & RegiRowCounter) 
      End If 

     Loop 

     'Reset the product range. 
     '-------------------------------------------------------------------------------------------------- 
     DataOldCounter = DataNewCounter 
     DataNewCounter = DataNewCounter + 1 

    End If 

    'Validate if item was purchased in the defined period and copy it. 
    '------------------------------------------------------------------------------------------------------ 
    If DataPurchase.Value = 0 Then 
     ActiveWorkbook.Sheets("Temp").Range("A" & TempRowCounter & ":D" & TempRowCounter).Value = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter & ":D" & DataRowCounter).Value 
     TempRowCounter = TempRowCounter + 1 
    End If 

    'Update row counter and values for previous and new product readed. 
    '------------------------------------------------------------------------------------------------------ 
    Set DataOldProd = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter) 
    DataRowCounter = DataRowCounter + 1 
    Set DataNewProd = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter) 
    Set DataPurchase = ActiveWorkbook.Sheets("Data").Range("J" & DataRowCounter) 

Loop 

'Code optimization to run faster. 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 

End Sub 

Answer 1

自動計算を無効に

Public Sub DoSomething() 
    ToggleWaitMode True 
    On Error GoTo CleanFail 

    'do stuff 

CleanExit: 
    ToggleWaitMode False 
    Exit Sub 
CleanFail: 
    'handle errors 
    Resume CleanExit 
End Sub 

とワークシートイベントショーuldはすでにかなり多くの助けをしています...しかし、決して "最適化"するものではありません。セルが変更されたときはいつでも、Excelの動作を大幅に低下させます。あなたのコードは動作しますが、ただ遅い場合

、VBAの審査にそれCode Review Stack Exchangeと存在にそれを取る：彼らはあなたが実際にあなたのコードの最適化を支援するために彼らの方法の外に行きますよ。私は知っている、私は彼らの一人だ）===