Question

我有一个充满X和O的Excel电子表格，如果在整行的任何给定点中有10个或更多个单元格彼此相邻，我需要更改单元格颜色。

示例：

XXXXXXOOOOOOOOOOOOOOOOOXX

XOXXXXOOXXOOXXXXXXXXXXXXXXX

OOOXXXXOOOOXXXOOOOOOOOOOO

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

我不确定如何处理这个......

修改的我道歉。我试图简化我的请求，但也许我应该把它全部放在那里。我有14个不同的变量可以在单元格中。 d，FA，FD，FI，I，J，L，M，O，P，T，U，V，X。如果除X和T之外的任何一个在同一行中彼此相邻10次或更多次，我需要将Interior.Color更改为红色。

我再次道歉。使用stackoverflow的新手。

Answer 1

使用条件格式代替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)

Answer 2

只是为了好玩而拍了一下......

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

Answer 3

@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

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

3 个答案: