Excel 将With功能中的内饰颜色应用于过滤范围

我想将

内饰颜色

应用于范围

B4:E15

内的产品列表
颜色在

黄色RGB（255255,0）

和

灰色RGB（217217217217）

之间切换，因此最后应该是这样的：

---

---

我试着使用这个

VBA

：

Option Explicit
    Sub Apply_Interior_Colour111()
      Dim lr As Long, fr As Long, i As Long
      Dim grey As Long, yellow As Long, interior_colour As Long
    
    With Sheet1
    
    lr = .Cells(.Rows.Count, 2).End(xlUp).Row
    fr = 4
    
    grey = RGB(217, 217, 217)
    yellow = RGB(255, 255, 0)
        
        For i = fr To lr
        If i = fr Then
        interior_colour = RGB(217, 217, 217)
        ElseIf .Cells(i, 2).Value <> .Cells(i, 2).Offset(-1, 0).Value Then
    
            If interior_colour = grey Then
            interior_colour = yellow
            Else
            interior_colour = grey
            End If
            
        End If
            
        .Range(.Cells(i, 2), .Cells(i, 5)).Interior.Color = interior_colour
            
        Next i
            
    End With
    
    End Sub

选项显式
子应用_内饰_颜色111（）
昏暗的lr一样长，fr一样长，i一样长
暗灰色与长款相同，黄色与长款相同，内饰颜色与长款相同
附页1
lr=.Cells（.Rows.Count，2）.End（xlUp）.Row
fr=4
灰色=RGB（217217217217）
黄色=RGB（255，255，0）
对于i=fr至lr
如果i=fr，那么
内饰颜色=RGB（217217217217）
ElseIf.Cells（i，2）.Value.Cells（i，2）.Offset（-1，0）.Value然后
如果内饰颜色=灰色，则
内饰颜色=黄色
其他的
内饰颜色=灰色
如果结束
如果结束
.Range（.Cells（i，2），.Cells（i，5））.Interior.Color=内饰颜色
接下来我
以
端接头

---

但是，结果如下所示：

---

我需要在

VBA

中更改什么，使其仅应用于过滤后的数据，并与第一个屏幕截图中的一样？

将内部颜色应用于过滤后的数据

• 我不明白为什么

  rng.Interior.Color=grey

  不会将灰色应用于未过滤的行
• 如果数据右侧为空列，底部为空行，则可以使用以下选项：

紧凑型版本

Option Explicit

Sub applyInterior()
    
    Const FirstCell As String = "B4"
    Dim grey As Long
    grey = RGB(217, 217, 217)
    Dim yellow As Long
    yellow = RGB(255, 255, 0)
    
    Dim FirstCellRange As Range
    Set FirstCellRange = Sheet1.Range(FirstCell)
    
    Dim rng As Range
    Set rng = FirstCellRange.CurrentRegion
    Set rng = FirstCellRange _
      .Resize(rng.Rows.Count + rng.Row - FirstCellRange.Row, _
              rng.Columns.Count + rng.Column - FirstCellRange.Column)
    
    Dim RowRange As Range
    For Each RowRange In rng.Rows
        RowRange.Interior.Color = grey
    Next RowRange
    
    rng.SpecialCells(xlCellTypeVisible).Interior.Color = yellow

End Sub

Option Explicit

Sub Apply_Interior_Colour111()
    
    Const FirstCell As String = "B4"
    Dim grey As Long
    grey = RGB(217, 217, 217)
    Dim yellow As Long
    yellow = RGB(255, 255, 0)
    
    Dim rng As Range
    Set rng = defineEndRange(Sheet1.Range(FirstCell))
    Dim RowRange As Range
    For Each RowRange In rng.Rows
        RowRange.Interior.Color = grey
    Next RowRange
    rng.SpecialCells(xlCellTypeVisible).Interior.Color = yellow

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Defines the range from a specified first cell to the last cell
'               of its Current Region. It is the Current Region minus the cells
'               to the left and above of the specified first cell.
' Remarks:      If the specified first cell is "A1", then its Current Region
'               and its End Range are the same.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function defineEndRange(FirstCellRange As Range) _
         As Range
    ' Initialize error handling.
    Const ProcName As String = "defineEndRange"
    On Error GoTo clearError
    ' Validate First Cell Range.
    If FirstCellRange Is Nothing Then
        GoTo NoFirstCellRange
    End If
    ' Define Current Region ('rng').
    Dim rng As Range
    Set rng = FirstCellRange.CurrentRegion
    ' Define End Range.
    Set defineEndRange = FirstCellRange _
      .Resize(rng.Rows.Count + rng.Row - FirstCellRange.Row, _
              rng.Columns.Count + rng.Column - FirstCellRange.Column)
    ' Exit.
    GoTo ProcExit
' Labels
NoFirstCellRange:
    Debug.Print "'" & ProcName & "': No First Cell Range."
    GoTo ProcExit
clearError:
    Debug.Print "'" & ProcName & "': " & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    On Error GoTo 0
    GoTo ProcExit
ProcExit:
End Function

第一个版本

Option Explicit

Sub applyInterior()
    
    Const FirstCell As String = "B4"
    Dim grey As Long
    grey = RGB(217, 217, 217)
    Dim yellow As Long
    yellow = RGB(255, 255, 0)
    
    Dim FirstCellRange As Range
    Set FirstCellRange = Sheet1.Range(FirstCell)
    
    Dim rng As Range
    Set rng = FirstCellRange.CurrentRegion
    Set rng = FirstCellRange _
      .Resize(rng.Rows.Count + rng.Row - FirstCellRange.Row, _
              rng.Columns.Count + rng.Column - FirstCellRange.Column)
    
    Dim RowRange As Range
    For Each RowRange In rng.Rows
        RowRange.Interior.Color = grey
    Next RowRange
    
    rng.SpecialCells(xlCellTypeVisible).Interior.Color = yellow

End Sub

Option Explicit

Sub Apply_Interior_Colour111()
    
    Const FirstCell As String = "B4"
    Dim grey As Long
    grey = RGB(217, 217, 217)
    Dim yellow As Long
    yellow = RGB(255, 255, 0)
    
    Dim rng As Range
    Set rng = defineEndRange(Sheet1.Range(FirstCell))
    Dim RowRange As Range
    For Each RowRange In rng.Rows
        RowRange.Interior.Color = grey
    Next RowRange
    rng.SpecialCells(xlCellTypeVisible).Interior.Color = yellow

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Defines the range from a specified first cell to the last cell
'               of its Current Region. It is the Current Region minus the cells
'               to the left and above of the specified first cell.
' Remarks:      If the specified first cell is "A1", then its Current Region
'               and its End Range are the same.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function defineEndRange(FirstCellRange As Range) _
         As Range
    ' Initialize error handling.
    Const ProcName As String = "defineEndRange"
    On Error GoTo clearError
    ' Validate First Cell Range.
    If FirstCellRange Is Nothing Then
        GoTo NoFirstCellRange
    End If
    ' Define Current Region ('rng').
    Dim rng As Range
    Set rng = FirstCellRange.CurrentRegion
    ' Define End Range.
    Set defineEndRange = FirstCellRange _
      .Resize(rng.Rows.Count + rng.Row - FirstCellRange.Row, _
              rng.Columns.Count + rng.Column - FirstCellRange.Column)
    ' Exit.
    GoTo ProcExit
' Labels
NoFirstCellRange:
    Debug.Print "'" & ProcName & "': No First Cell Range."
    GoTo ProcExit
clearError:
    Debug.Print "'" & ProcName & "': " & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    On Error GoTo 0
    GoTo ProcExit
ProcExit:
End Function

---

使用

特殊单元格（xlCellTypeVisible）

。我们如何知道

产品必须为黄色？你会在过滤数据后应用颜色吗？是的，它会在过滤后应用。你指的是通过
Product\E
进行过滤？所以所有过滤后的单元格都可以被着色为黄色？您不能使用条件格式吗？