Excel 如果10个以上的触摸单元格具有相同的值，则更改单元格颜色

我有一个Excel电子表格，里面有X和O，如果整行的任何一个给定点上有十个或更多的单元格相邻，我需要更改单元格颜色

例如：

XXXXXX OOOOOOOOXX xOxxooxxooxxxxxxxxxxxxx oooxxxxoooxxxooooooooooooooo

在第一行中，我需要所有17个O的细胞颜色都改变，因为它们彼此相邻10个或更多。依此类推第2行和第3行

我不知道如何处理这个问题

编辑 我道歉。我试着简化我的要求，但也许我应该把它全部说出来。我有14个不同的变量可以在单元格中。D、 FA、FD、FI、I、J、L、M、O、P、T、U、V、X。如果X和T之外的任何一个在同一行中相邻10次或以上，我需要内饰。颜色更改为红色

---

我再次道歉。刚开始使用stackoverflow。

只是为了好玩才尝试一下

Sub XsandOs()

Dim lastrow As Long, lastcol As Long, xcounter As Long, ocounter As Long

lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
lastcol = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column

For i = 1 To lastrow
    For j = 1 To lastcol
        If Cells(i, j).Value = "x" Then
            xcounter = xcounter + 1
            If j = lastcol Then xcounter = 0
            ocounter = 0
            If xcounter = 10 Then
                Range(Cells(i, j - 9), Cells(i, j)).Interior.Color = vbRed
            End If
        ElseIf Cells(i, j).Value = "o" Then
            ocounter = ocounter + 1
            If j = lastcol Then ocounter = 0
            xcounter = 0
            If ocounter = 10 Then
                Range(Cells(i, j - 9), Cells(i, j)).Interior.Color = vbRed
            End If
        End If
    Next j
Next i

End Sub

---

使用条件格式而不是vba：

使用以下公式为列a:Y创建新规则：

=AND(A1<>"",IFERROR(AGGREGATE(15,6,COLUMN(A1:$Y1)/(A1:$Y1=IF(A1="X","O","X")),1),COLUMN($Y1))-IFERROR(AGGREGATE(14,6,COLUMN($A1:A1)/($A1:A1=IF(A1="X","O","X")),1),COLUMN($A1))>=10)

---

@ScottCraner解决方案无疑是一个值得选择的解决方案，但我喜欢我的VBA解决方案，所以我将把它加入到混合中

该代码假定您只有X和O，但会将任何重复值着色为10或更多

Public Sub Test()

    Dim rLastCell As Range
    Dim rCell As Range
    Dim rFirstCell As Range
    Dim rCurrentCell As Range

    Set rLastCell = LastCell(ThisWorkbook.Worksheets("Sheet1"))

    With ThisWorkbook.Worksheets("Sheet1")
        'A For Each will step through each cell going across the columns and then down the rows.
        'Just need to reset if the it's the first column and check if the next cell is equal to the previous
        'and reset when it changes.
        For Each rCell In .Range(.Cells(1, 1), rLastCell)
            If rCell.Column = 1 Then
                Set rFirstCell = rCell
            ElseIf rCell.Value <> rFirstCell.Value Then
                If rCell.Column - rFirstCell.Column >= 10 Then
                    rFirstCell.Resize(, rCell.Column - rFirstCell.Column).Interior.Color = RGB(255, 0, 0)
                End If
                Set rFirstCell = rCell
            End If
        Next rCell
    End With

End Sub

Public Function LastCell(wrkSht As Worksheet, Optional Col As Long = 0) As Range

    Dim lLastCol As Long, lLastRow As Long

    On Error Resume Next

    With wrkSht
        If Col = 0 Then
            lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        Else
            lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            lLastRow = .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
        End If

        If lLastCol = 0 Then lLastCol = 1
        If lLastRow = 0 Then lLastRow = 1

        Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
    End With
    On Error GoTo 0

End Function

---

每个X或O都在自己的单元格中吗？到目前为止你都试了些什么？是的，每个X或O都在自己的牢房里。我不知道怎么做。我想知道我是否应该做一个X和O范围，并使用Intersect进行测试。但这只会限制我在测试范围内放置的X或O的数量。