Excel VBAスクリプトアシスタント

Question

Excelでフィールドを比較するためのVBAスクリプトを作成しました。 Excelは、ボタンをクリックすると、フリーズします。エラーメッセージは表示されません。私はそれを実行しようとするたびに、私はコントロールのaltを使用してExcelを終了する必要があります。 私の変数の一つがコメントアウトされています。これがうまくいくと、フォントを変更せずにデータを別のシートにコピーする予定です。ちょうどFYI

Private Sub CommandButton4_Click() 
Dim rng1, rng2, cell1, cell2 As Range 
Set rng1 = Worksheets("Main").Range("B:B") 
Set rng2 = Worksheets("CSV Transfer").Range("D:D") 
'Set rng3 = Worksheets("Data").Range("A:A") 

For Each cell1 In rng1 
For Each cell2 In rng2 

If IsEmpty(cell2.Value) Then Exit For 
If cell1.Value = cell2.Value Then 

cell1.Font.Bold = True 
cell1.Font.ColorIndex = 2 
cell1.Interior.ColorIndex = 3 
cell1.Interior.Pattern = xlSolid 
cell2.Font.Bold = True 
cell2.Font.ColorIndex = 2 
cell2.Interior.ColorIndex = 3 
cell2.Interior.Pattern = xlSolid 

End If 

Next cell2 
Next cell1 


End Sub 

編集：私の実際の問題を反映するように変更されました。

Answer 1

マクロはフリーズしていないので、完了までに十分な時間が与えられていないだけです。これは時間に関係します。 Excelには1,048,576行の行制限があり、各行のすべてのセルを他の行のすべての単一セルと比較しています。それは合計1,099,511,627,776のセル比較です。 1秒間に100,000回の比較を行うことができると仮定すると（でもの書式設定なし）、最終的にわずか127日間で完了します。

私はいくつかのことをお勧めします。だけでなく、使用されているもの - まず、あなたがこのような列の範囲を割り当てるときに...

Set rng1 = Worksheets("Main").Range("B:B") 

...あなたはすべての可能セルを取得します。各列の最後の非空のセルを検索し、それに基づいて、あなたの範囲を設定します。

Dim LastRow As Long 
Dim ColumnB As Range 
With Worksheets("Main") 
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 
    Set ColumnB = .Range("B1:B" + LastRow) 
End With 

あなたは巨大なデータセットを持っていない限り、これは分または秒の代わりの日のためにあなたの実行時間をいただく場合がございます。さらに、それらを改善するために、一度にワークシート1から個々の値を要求して停止し、アレイにそれらを引っ張る：

Dim BValues As Variant 
BValues = ColumnB.Value 

そして、単にループを介して、メモリ内の値を比較します。あなたのパフォーマンスは依然として低すぎる場合、私はまた、非常に少なくともScreenUpdatesをオフにしたい

Private Sub CommandButton4_Click() 
    Dim LastRow As Long, MainSheet As Worksheet, CsvSheet As Worksheet 

    Set MainSheet = Worksheets("Main") 
    Set CsvSheet = Worksheets("CSV Transfer") 

    Dim MainValues As Variant 
    With MainSheet 
     LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 
     MainValues = .Range("B1:B" & LastRow).Value 
    End With 

    Dim CsvValues As Variant 
    With CsvSheet 
     LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 
     CsvValues = .Range("D1:D" & LastRow).Value 
    End With 

    Dim MainRow As Long, CsvRow As Long 
    For MainRow = LBound(MainValues) To UBound(MainValues) 
     For CsvRow = LBound(CsvValues) To UBound(CsvValues) 
      If MainValues(MainRow) = CsvValues(CsvRow) Then 
       FormatCell MainSheet, MainRow, 2 
       FormatCell CsvValues, CsvRow, 4 
      End If 
     Next 
    Next 
End Sub 

Private Sub FormatCell(sheet As Worksheet, formatRow As Long, formatCol As Long) 
    With sheet.Cells(formatRow, formatCol) 
     With .Font 
      .Bold = True 
      .ColorIndex = 2 
     End With 
     With .Interior 
      .ColorIndex = 3 
      .Pattern = xlSolid 
     End With 
    End With 
End Sub 

：それはより多くのようになります（私はサブに出て書式設定引き込ま）。