Excel VBA脚本帮助

我编写了一个VBA脚本来比较excel中的字段。Excel会在我单击按钮时冻结。它从不显示任何错误消息。每次尝试运行它时，我都必须使用control alt delete关闭excel。 我的一个变量被注释掉了，因为在我完成这项工作后，我计划将数据复制到另一个工作表中，而不是更改字体。仅供参考

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

---

编辑：整个帖子已经更改以反映我的实际问题。

你的宏没有冻结，你只是没有给它足够的时间来完成-这是一个漫长的时间。Excel的行限制为1048576行，您要将每行中的每个单元格与另一行中的每个单元格进行比较。这总共是109951162776个单元格的比较。假设每秒可以进行100000次比较（即使没有格式，也可能是一段时间），这将最终在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