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如果你的表现仍然太低。