Vba 遍历单元格以更改单元格颜色太慢

如果工作簿中的所有单元格还没有颜色，我想将其内部更改为白色。我有一个正在工作的宏（见下文），但是它非常慢，并且经常崩溃。如果我手动执行代码，或者它碰巧没有崩溃，那么它工作得很好，但当然非常慢

有人能帮我找出如何让它运行得更快吗

亲切问候,， 坦率的

---

您可以尝试

Union

范围，然后像下面这样一次性更改

ColorIndex

，看看它是否工作得更快

Sub Fill_Cells_White_When_Blank()
    Dim mSheet As Worksheet
    Dim mCell As Range, mCells As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    On Error Resume Next    
    For Each mSheet In Workbooks("Name.xlsx").Worksheets
        Set mCells = Nothing
        For Each mCell In mSheet.UsedRange
            If mCell.Interior.ColorIndex = xlNone Then
                If mCells Is Nothing Then
                    Set mCells = mCell
                Else
                    Set mCells = Union(mCells, mCell)
                End If
            End If
        Next
        If Not mCells Is Nothing Then mCells.Interior.ColorIndex = 2
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

---

您可以使用“查找和替换”对话框。它允许您选择要搜索的格式，并替换为所需的格式。试试看

---

@Ricardo A:非常感谢您的编辑，我认为这使文章更容易理解。显然（也许我遗漏了什么），您正在逐个更改工作表中每个单元格的颜色。如果您正在使用Office 2016，则表示您正在将颜色更改为16384（列）X 1048576（行）=17179869184。这应该需要一些时间，你不认为吗？顺便问一下，你知道Excel的条件格式功能吗？更正我的第一条评论：你正在更改Excel中每个工作表中每个单元格的颜色，因此17179869184 X工作表数=BIIIGGG数@实际上，他只是在更改每张工作表上的

UsedRange

。但是，仍然可能有大量的细胞，为什么下一步错误恢复时会出现

，

，对于每一个被测试的细胞？？？@Gary的学生，非常感谢。这是一个完美的解决方案。不知何故，为整个范围设置属性要快得多。单细胞法每片约5分钟（如果没有失败）。整个工作簿的接近时间为10秒！（下一份简历在那里，因为奇怪的是，我认为错误与#NV单元格值有关）@Franksta可能与每张工作表的单元格“交互”有关。在这里，我们将为n个单元更改一次，而不是n次！谢谢你的建议。我没有使用这种方法，因为我的实际问题更大。我将有一个完整的颜色数组，需要在几个工作簿中映射，一个接一个地映射需要花费太长时间。对不起，我应该补充一点，我只是试着专注于我无法解决的问题。好吧，你也可以在VBA中这样做。只需运行宏记录器并在GUI中执行所有操作。清除生成的代码并在代码中使用它。：）

Sub Fill_Cells_White_When_Blank()
    Dim mSheet As Worksheet
    Dim mCell As Range, mCells As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    On Error Resume Next    
    For Each mSheet In Workbooks("Name.xlsx").Worksheets
        Set mCells = Nothing
        For Each mCell In mSheet.UsedRange
            If mCell.Interior.ColorIndex = xlNone Then
                If mCells Is Nothing Then
                    Set mCells = mCell
                Else
                    Set mCells = Union(mCells, mCell)
                End If
            End If
        Next
        If Not mCells Is Nothing Then mCells.Interior.ColorIndex = 2
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub