循环显示2列并突出显示无序值

Posted 2023-01-14

valid cases in green invalid cases in orange请参考图片需要帮助

我在一张纸上有两列。 A列 - 包含表格名称例如：ABC，ABC，ABC，BCD，BCD，BCD，CDE，CDE B列 - 包含值例如：1,2,3,4

对于每个表都有一个依赖值，例如：

ColumnA      Column B
    ABC            1
    ABC            2
    ABC            3
    BCD .          1
    BCD            2
    BCD            4
    CDE            2
    CDE            4

对于每个表列，应该是主要的值流。 ABC应该是1然后是2然后3/4如果ABC对应值是1而第二个值不是2然后高亮2.如果ABC值直接以2/3/4开始然后突出显示。

应该始终为每个应该遵循的表格进行处理 - 1,2,3 / 4

谢谢百万提前

尝试了两个循环

Sub highlight()    
With Sheets(1)
    For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row ' loop until last row with data in column "B" (skip blank rows)
        If Trim(.Range("A" & i).Value) <> "" Then ' check if value in cell in column "L" in current row is not empty
            'SQL Code entered here'
            MsgBox Cells(i, 1).Value   
        End If
    Next i
End With
End Sub

很长的路没得到答案需要一些新的代码。

答案

你不需要VBA。以下条件格式规则将执行此任务：

=OR(AND($B2=4,COUNTIF($A$2:$A2,$A2)=3),COUNTIF($A$2:$A2,$A2)=$B2)

另一答案

可以尝试像VBA（测试）

Sub highlight()
Dim Ws As Worksheet
Dim Rw As Long, LastRow As Long, C As Range, Rank As Long
Dim FirstAddress As String, Srch As String
Set Ws = ThisWorkbook.Sheets(1)


With Ws
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A2:B" & LastRow).Interior.Color = RGB(255, 255, 255)  ' reset Color to white as checking criteria

    For Rw = 2 To LastRow ' loop until last row with data in column "B" (skip blank rows)
    Srch = .Range("A" & Rw).Value
        If .Range("A" & Rw).Interior.Color = RGB(255, 255, 255) And Srch <> "" Then ' check only if Not checked before & marked or cell value not empty
        Rank = 1              ' 1st Order
            Set C = .Range("A1:A" & LastRow).Find(Srch, LookIn:=xlValues, LookAt:=xlWhole)
                If Not C Is Nothing Then
                FirstAddress = C.Address
                    Do
                    If C.Offset(0, 1).Value = Rank Then
                    .Range(C, C.Offset(0, 1)).Interior.Color = RGB(0, 255, 0) '  may change Color value to your choice
                    Else
                    .Range(C, C.Offset(0, 1)).Interior.Color = RGB(255, 0, 0) '  may change Color value to your choice
                    End If
                    Set C = .Range("A1:A" & LastRow).FindNext(C)
                    Rank = Rank + 1               'Next Order
                    Loop While Not C Is Nothing And C.Address <> FirstAddress
                End If
        End If
    Next Rw
End With
End Sub

样品运行