パフォーマンスの最適化

Question

私はこのコードを実行時の90％のように使います。

約8000行あり、情報が列Aに格納されています。このコードは、この情報を他の列に分割しています。 実行に約15分かかります（：O）。 パフォーマンスを改善する方法についてのご意見はありますか？

For i = 2 To Row_Number ' Loop for each row 

    If InStr(Cells(i, 1), "//") = 0 Then ' This means that if // appears somewhere in the text we delete all the rows (including this one) (see Else :) and stop the loop 
     j = 1 
     Do Until Mid(Cells(i, 1), j, 1) = ";" 
      j = j + 1 
     Loop 
     LongVIN = Mid(Cells(i, 1), 1, j - 1) 
     k = j 
     j = j + 1 
     Do Until Mid(Cells(i, 1), j, 1) = ";" 
      j = j + 1 
     Loop 
     Cells(i, 3) = Mid(Cells(i, 1), k + 1, j - k - 1) ' Model 
     k = j 
     j = j + 1 
     Do Until Mid(Cells(i, 1), j, 1) = ";" 
      j = j + 1 
     Loop 
     Cells(i, 4) = Mid(Cells(i, 1), k + 1, j - k - 1) ' Dealer 
     k = j 
     j = j + 1 
     Do Until Mid(Cells(i, 1), j, 1) = ";" 
      j = j + 1 
     Loop 

     k = j 
     j = j + 1 
     Do Until Mid(Cells(i, 1), j, 1) = ";" 
      j = j + 1 
     Loop 
     Cells(i, 6) = Mid(Cells(i, 1), k + 1, j - k - 1) ' Region 

     k = j 
     j = j + 1 
     Do Until Mid(Cells(i, 1), j, 1) = ";" 
      j = j + 1 
     Loop 
     Cells(i, 7) = CDate(Mid(Cells(i, 1), k + 1, j - k - 1)) ' Retail Date 
     k = j 

     Cells(i, 5) = Mid(Cells(i, 1), k + 1, Len(Cells(i, 1)) - k) '(Len - (k+1) +1) Dealer Name 

     Cells(i, 1) = Mid(LongVIN, 1, 10) 
     Cells(i, 2) = Mid(LongVIN, 11, 7) 

    Else: 
     Range("A" & i & ":A" & Row_Number).Delete 'ClearContents 
     Exit For 

    End If 

Next i 

Answer 1

あなたは、配列内のデータを格納する配列上で動作し、バックスプレッドシートにデータを格納することで、パフォーマンスが大幅にブーストが表示されるはずです。以下のような

何か：今の代わりに、Cells(i, 1)からの読み取り

Dim data As Variant 
Dim result As Variant 

data = Range(Cells(2, 1), Cells(Row_Number, 1)) 
Redim result (1 To Row_Number, 1 To 7) As Variant 

は、あなたがdata(i, 1)から読み込まれ、代わりにCells(i, n)への書き込みのあなたはresult(i, n)に書き込みます。

そして、あなたのコードの末尾：

Range(Cells(2, 1), Cells(Row_Number, 7)) = result