遍历2列并突出显示无序值

时间:2019-04-10 15:07:41

标签: excel vba

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

很长一段时间没有得到答案,需要一些新代码。

2 个答案:

答案 0 :(得分:0)

您不需要VBA。以下条件格式规则将完成此任务:

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

答案 1 :(得分:0)

可以尝试在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

样品运行 enter image description here