同时循环遍历行和命名范围中的所有单元格

时间:2018-08-15 07:20:31

标签: excel vba excel-vba named-ranges

道歉,我是VBA新手。

我正在寻找一种方法,可以循环遍历一行中的所有单元格,并且如果该单元格是命名范围“ Targets”的一部分,则背景颜色会发生变化。

我最初是使用下面的代码完成此操作的,在该代码中,我将检查指定范围内的所有单元格,但是它变得如此缓慢,因此不切实际。我希望通过将功能限制为仅活动行来加快宏的速度。

我尝试了各种版本的Intersect,虽然我可以选择要查看的单元格,但我仍在努力使用结果。

Dim cell As Range
For Each cell In Sheet5.Range("Targets")
    'Blank cells
    If Cells(cell.Row, "JE").Value = "" Then
        cell.Interior.Color = xlNone
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    ElseIf cell.Value = "" And Month(Cells(cell.Row, "").Value) Mod 2 = 0 Then 'Odd
        cell.Interior.Color = RGB(221, 221, 221)
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    ElseIf cell.Value = "" And Month(Cells(cell.Row, "").Value) Mod 2 = 1 Then  'Even
        cell.Interior.Color = xlNone
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    '1-5 days Early (Green)
    ElseIf cell.Offset(0, 1).Value = "" And cell.Value >= Application.WorksheetFunction.WorkDay(Date, 1, [Support!B4:B100]) And cell.Value <= Application.WorksheetFunction.WorkDay(Date, 5, [Support!B4:B100]) Then
        cell.Interior.Color = RGB(188, 253, 175)
        cell.Font.Bold = True
        cell.Font.Color = RGB(84, 130, 53)
    '1-3 Days Overdue (Orange)
    ElseIf cell.Offset(0, 1).Value = "" And cell.Value <= Application.WorksheetFunction.WorkDay(Date, -1, [Support!B4:B100]) And cell.Value >= Application.WorksheetFunction.WorkDay(Date, -3, [Support!B4:B100]) Then
        cell.Interior.Color = RGB(255, 168, 39)
        cell.Font.Bold = True
        cell.Font.Color = vbWhite
    '1-3 Days Overdue (Red)
    ElseIf cell.Offset(0, 1).Value = "" And cell.Value < Application.WorksheetFunction.WorkDay(Date, -3, [Support!B4:B100]) Then
        cell.Interior.Color = RGB(158, 0, 0)
        cell.Font.Bold = True
        cell.Font.Color = vbWhite
    'Today (Blue)
    ElseIf cell.Offset(0, 1).Value = "" And cell.Value = Application.WorksheetFunction.WorkDay(Date, 0, [Support!B4:B100]) Then
        cell.Interior.Color = RGB(4, 119, 224)
        cell.Font.Bold = True
        cell.Font.Color = vbWhite
    ElseIf Month(Cells(cell.Row, "").Value) Mod 2 = 0 Then 'Odd
        cell.Interior.Color = RGB(221, 221, 221)
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    Else: Month (Cells(cell.Row, "").Value) Mod 2 = 1 'Even
        cell.Interior.Color = xlNone
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    End If
Next

1 个答案:

答案 0 :(得分:0)

要检查某个范围是否在另一个范围内,可以使用Application.Intersect Method

下面是检查A1是否在NamedRange中的示例:

If Not Intersect(Range("A1"), Range("NamedRange")) Is Nothing Then
    'A1 is in NamedRange
Else
    'A1 is not it NamedRange
End If