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

【问题标题】：Loop through all Cells in a Row and a Named Range Simultaneously同时循环遍历一行中的所有单元格和一个命名范围
【发布时间】：2018-08-15 07:20:30
【问题描述】：

先道歉，我是 VBA 新手。

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

我最初使用下面的代码来完成此操作，我将检查命名范围内的所有单元格，但它变得如此缓慢以至于不实用。我希望通过将函数限制为仅活动行来加速宏。

我尝试了各种版本的 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

【问题讨论】：

标签： vba excel named-ranges

【解决方案1】：

要检查一个范围是否在另一个范围内，您可以使用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

【讨论】：

谢谢，这让我走上了正轨。全部固定并像蒸汽火车一样运行。