遍历颜色填充的单元格直到空白

Question

我正在尝试创建一个我填充了单元格的Excel文档（单元格的相关数量不同，一些只有1个，其他10+，列数相同）

我要选择“ activeCell区域”。所以例如如果活动单元格是A11，则选择从A11一直到E14的填充区域（所有蓝色单元格）。

这是我目前所得到的，我假设我需要一个while循环，但是我无法使其工作：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.Worksheet.Range("N5:N1000")) Is Nothing Then
        If Cells(Target.Row, 1).Interior.ColorIndex <> xlNone Then
            If Cells(Target.Row, 14) = "x" Or Cells(Target.Row, 14) = "X" Then
                         Range("A" & ActiveCell.Row).Select

            End If
        End If
   End If

End Sub

Excel表格：

步骤1：

第2步：

步骤3：

Answer 1

如果要扩展单个单元格范围以覆盖相同填充的矩形范围，可以执行以下操作：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range

    Set c = Application.Intersect(Target.Cells(1), Me.Range("N5:N1000"))

    If Not c Is Nothing Then
        If Me.Cells(c.Row, 1).Interior.ColorIndex <> xlNone And _
                        UCase(Me.Cells(Target.Row, 14)) = "X" Then

            GetColorBlock(Me.Cells(c.Row, 1)).Select

        End If
    End If

End Sub

'Expand a single cell range to all neighboring cells with the same fill color
'  (assumes colored range is rectangular)  
Function GetColorBlock(c As Range) As Range
    Dim tl As Range, br As Range, clr As Long
    clr = c.Interior.Color
    Set tl = c
    Set br = c
    Do While tl.Row > 1
        If tl.Offset(-1, 0).Interior.Color <> clr Then Exit Do
        Set tl = tl.Offset(-1, 0)
    Loop
    Do While tl.Column > 1
        If tl.Offset(0, -1).Interior.Color <> clr Then Exit Do
        Set tl = tl.Offset(0, -1)
    Loop
    Do While br.Row < Rows.Count
        If br.Offset(1, 0).Interior.Color <> clr Then Exit Do
        Set br = br.Offset(1, 0)
    Loop
    Do While br.Column < Columns.Count
        If br.Offset(0, 1).Interior.Color <> clr Then Exit Do
        Set br = br.Offset(0, 1)
    Loop
    Set GetColorBlock = c.Worksheet.Range(tl, br)
End Function