VBA程序為所有具有值的單元格着色

Question

我剛剛開始自學VBA，所以在此先感謝。 為什么這給我一個錯誤？ 該代碼搜索將來的日期列。 然后在該列中搜索具有值的所有單元格，並將其着色為黃色。

謝謝！

    Sub Macro1()
     Dim cell As Range
     Dim cell2 As Range
     Dim ColumnN As Long



For Each cell In Range("I2:ZZ2")

    If cell.Value > Now() Then

    '

    ColumnN = cell.Column
    ColumnL = ConvertToLetter(ColumnN)
    MsgBox ColumnL & cell.Row

        For Each cell2 In Range("ColumnL:ColumnL")

            If Not cell2 Is Empty Then



                cell2.Interior.ColorIndex = 6

            End If

        Next cell2
    End If
   End Sub()





    Function ConvertToLetter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    ConvertToLetter = vArr(0)
    End Function

Answer 1

要檢查單元格是否為空，您需要切換操作順序。 將您的If Not語句切換為If Not IsEmpty(cell2) Then 。

另外，強烈建議不要命名您的變量cell ，因為這與Excel使用的一些“特殊詞”（我忘記了技術術語）非常接近。 我總是只使用cel代替。

Sub test()
Dim cel     As Range
Dim cel2    As Range
Dim ColumnN As Long

For Each cel In Range("I2:ZZ2")

    If cel.Value > Now() Then

        ColumnN = cel.Column
        ' ColumnL = ConvertToLetter(ColumnN)
        ' MsgBox ColumnL & cell.Row
        If Not IsEmpty(cel) Then
            cel.Interior.ColorIndex = 6
        End If
    End If
Next cel

End Sub

編輯：如果您注意到，我還調整了cell2 range 。 這消除了運行另一個宏的需要（有時可能會導致問題），因此您只需要Number列。

Edit2：我刪除了“ ColumnL”范圍選擇-這是做什么用的？ 我可以重新添加它，但不確定為什么要遍歷I：ZZ列，而在N列中僅具有高亮顯示。

EDIT2：

我調整了代碼，現在它更短了，應該運行得更快一些：

Sub Macro2()

Dim cel As Range, rng As Range
Dim lastCol As Long

Application.ScreenUpdating = False

lastCol = Cells(2, 9).End(xlToRight).Column ' Note, this assumes there are NO gaps in the columns from I:ZZ
'lastCol = cells(2,16384).End(xltoleft).column ' use this instead, if there are gaps in I2:ZZ2

Set rng = Range(Cells(2, 9), Cells(2, lastCol))

For Each cel In rng

    If cel.Value > Now() Then
        cel.Interior.ColorIndex = 6
    End If
Next cel
Application.ScreenUpdating = True
End Sub

Answer 2

你快到了！ 有兩個主要問題要解決：

更換：

For Each cell2 In Range("ColumnL:ColumnL")

同

For Each cell2 In Range(ColumnL & ":" & ColumnL)

和

If Not cell2 Is Empty Then

同

If Not IsEmpty(cell2) Then

這將導致以下結果：

Sub Macro1()

Dim cell As Range
Dim cell2 As Range
Dim ColumnN As Long
Dim ColumnL As String


For Each cell In Range("I2:ZZ2")

    If cell.Value > Now() Then

        ColumnN = cell.Column
        ColumnL = ConvertToLetter(ColumnN)
        MsgBox ColumnL & cell.Row

        For Each cell2 In Range(ColumnL & ":" & ColumnL)

            If Not IsEmpty(cell2) Then



                cell2.Interior.ColorIndex = 6

            End If

        Next cell2

    End If
Next cell

End Sub


    Function ConvertToLetter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    ConvertToLetter = vArr(0)
    End Function

盡管效率低下，但可以完成工作！