Excel VBA腳本幫助

Question

我寫了一個VBA腳本來比較excel中的字段。 Excel凍結第二個我點擊按鈕。它從不顯示任何錯誤消息。每次我嘗試運行它時，都必須使用控制alt delete來關閉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

你的宏沒有凍結，你只是沒有給它足夠的時間來完成 - 這是一個lonnnngggg時間。 Excel的行數限制爲1,048,576行，並且您將每行中的每個單元格與另一行中的每個單元格進行比較。這是共計1,099,511,627,776個單元格比較。假設您可以每秒進行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 

這可能讓你的運行時間在幾分鐘或幾秒鐘而不是幾天的順序，除非你有一個龐大的數據集。爲了進一步提高他們，停在要求的時間從工作表中一個單獨的值，並將其拉入數組：

Dim BValues As Variant 
BValues = ColumnB.Value 

然後，只需遍歷並在內存中比較值。它看起來更多的東西像這樣（我把格式化了成子）：

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 

我也想關閉的最起碼ScreenUpdates如果你的表現仍然太低。