次のタスクをより速く行う方法について誰かがアイデアを持っていれば本当にありがたいです。列Aに名前のリストがあり、それらの名前のいずれかが列Cに表示されるかどうかを確認したいと思います。以下のコードは、500個の名前でテストするとうまく機能します。しかし、列Aに約3000個、列Cに150000個の値がある完全なデータを使用すると、2時間近く経過していて終了していないため、正しく実行されているかどうかわかりません。
Sub compare_cols122()
Dim NameList As Worksheet
Dim i As Long, j As Long
Dim LastRow As Long
Set NameList = Excel.Worksheets("Names")
LastRow = NameList.UsedRange.Rows.Count
Application.ScreenUpdating = False
For i = 2 To LastRow
For j = 2 To LastRow
If NameList.Cells(i, 1).Value <> "" Then
If InStr(1, NameList.Cells(j, 3).Value, NameList.Cells(i, 1).Value, vbTextCompare) > 0 Then
NameList.Cells(j, 3).Interior.ColorIndex = 6
NameList.Cells(i, 1).Interior.ColorIndex = 6
Exit For
Else
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
データを配列にロードしてそれらとの比較を実行することにより、コードが高速化されます。
Sub compare_cols122()
Dim NameList As Worksheet
Dim i As Long, j As Long
Set NameList = Excel.Worksheets("Names")
Dim rngNames As Range
Set rngNames = Range("A1", Range("A1").Offset(Rows.Count - 1).End(xlUp))
Dim varNames As Variant
varNames = rngNames.Value2
Dim rngData As Range
Set rngData = Range("C1", Range("C1").Offset(Rows.Count - 1).End(xlUp))
Dim varData As Variant
varData = rngData.Value2
Application.ScreenUpdating = False
For i = LBound(varNames) + 1 To UBound(varNames)
For j = LBound(varData) + 1 To UBound(varData)
If varNames(i, 1) <> "" Then
If InStr(1, varData(j, 1), varNames(i, 1), vbTextCompare) > 0 Then
NameList.Cells(j, 3).Interior.ColorIndex = 6
NameList.Cells(i, 1).Interior.ColorIndex = 6
Exit For
Else
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
内側のループと外側のループを入れ替えると、一致の頻度に関係なく、検索が遅くなるだけであることに注意してください。
セルからデータを何度も読み取るのは非効率的です。
配列を使用して、すべての値をにロードします。
次に、アレイに対して必要なことを実行します。
すべてが完了したら、値をセルに戻します。