☰

Excel 宏更改背景颜色

tag-icon • tag-icon microsoft-excel vba macros
Excel 宏更改背景颜色

我正在编写一个简单的 Excel 宏，根据单元格值更改背景颜色。这基本上是在 Excel 中显示图像。但是，以下代码导致 Excel 毫无原因地崩溃。

Option Explicit


Sub SetBgColor()
    On Error GoTo ErrHandler

    Dim Data As Worksheet
    Set Data = Sheets("Data")

    Dim i As Long
    Dim j As Long

    Dim MaxRows As Long
    MaxRows = 693

    Dim MaxCols As Long
    MaxCols = 400


    Dim CellVal As Integer
    For i = 1 To Rows.Count
        For j = 1 To MaxCols
            CellVal = Data.Cells(i, j).Value Mod 255

            If i Mod 3 = 0 Then
                Data.Cells(i, j).Interior.Color = RGB(0, 0, CellVal)
            ElseIf i Mod 3 = 1 Then
                Data.Cells(i, j).Interior.Color = RGB(CellVal, 0, 0)
            ElseIf i Mod 3 = 2 Then
                Data.Cells(i, j).Interior.Color = RGB(0, CellVal, 0)
            End If
        Next j
    Next i

ErrHandler:
Dim Msg As String

If Err.Number <> 0 Then
    Msg = "Error #" & Str(Err.Number) & " generated by " & Err.Source & Chr(13) _
        & "Error Line: " & Erl & Chr(13) _
        & Chr(13) _
        & Err.Description

    MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If

End Sub

工作表包含 400 列和 693 行。宏启动正常，但 Excel 在运行过程中随机崩溃，我不知道原因。

我已经添加了错误处理代码，但是什么都没有显示。

另外，有没有比循环遍历每一列和每一行更有效的方法？

答案1

尝试这个：

Sub SetBgColor()
On Error GoTo ErrHandler

Dim Data    As Worksheet
Set Data = Sheets("Data")

Dim i       As Long
Dim j       As Long

With Data
    Dim MaxRows As Long
    MaxRows = .Cells(.Rows.Count, 1).End(xlUp).Row    ' assuming Column A (1) has the most data

    Dim MaxCols As Long
    MaxCols = .Cells(1, .Columns.Count).End(xlToLeft).Column    ' assuming your row 1 has the most column data

    Dim CellVal As Integer
    For i = 1 To MaxRows
        For j = 1 To MaxCols
            CellVal = .Cells(i, j).Value Mod 255
            If i Mod 3 = 0 Then
                .Cells(i, j).Interior.Color = RGB(0, 0, CellVal)
            ElseIf i Mod 3 = 1 Then
                .Cells(i, j).Interior.Color = RGB(CellVal, 0, 0)
            ElseIf i Mod 3 = 2 Then
                .Cells(i, j).Interior.Color = RGB(0, CellVal, 0)
            End If
        Next j
    Next i
End With                     'Data

Exit Sub

ErrHandler:
Dim Msg     As String

If Err.Number <> 0 Then
    Msg = "Error #" & Str(Err.Number) & " generated by " & Err.Source & Chr(13) _
          & "Error Line: " & Erl & Chr(13) _
          & Chr(13) _
          & Err.Description

    MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If

End Sub

我认为，主要问题是你正在循环所有行在工作表中，这可能需要很长时间，并且可能导致工作簿崩溃。相反，我将您的第一个For循环更改为For i = 1 to MaxRows。

除此之外，我还做了一些调整，使宏更加动态，并尽可能避免使用“硬编码”数字。这假设您的 A 列包含最多的数据，而第 1 行包含最多的列数据。

答案2

事实上，Excel 陷入了循环冻结，无法刷新其窗口，因此看起来就像卡住了一样。

DoEvents解决的办法是在循环中调用。

For i = 1 To MaxRows
    For j = 1 To MaxCols
        CellVal = .Cells(i, j).Value Mod 255
        If i Mod 3 = 0 Then
            .Cells(i, j).Interior.Color = RGB(0, 0, CellVal)
        ElseIf i Mod 3 = 1 Then
            .Cells(i, j).Interior.Color = RGB(CellVal, 0, 0)
        ElseIf i Mod 3 = 2 Then
            .Cells(i, j).Interior.Color = RGB(0, CellVal, 0)
        End If
    Next j
    DoEvents
Next i

相关内容