VBA代码问题：如何排除B列值为“No”的行进行三列数据对比？

我有一组三列数据，需要在数据对比过程中排除B列（压缩模式列）值为“No”的行，但目前编写的VBA代码没实现这个排除逻辑，麻烦帮忙指出缺失部分。

原代码如下：

Dim uData (), vData(), rg as range, rCount As Long, X as variant
Dim  urg As Range, r As Long, uStr As String, i As Integer
Dim  dict As Object
X = RGB(200, 205, 5)
With sheets("Data")
    With Intersect(.UsedRange, .Range("A15:C2000"))
        rCount = .Rows.Count
        Set rg = .Resize(rCount)
    End With
End With

uData = rg.Columns(1).Value
vData = rg.Columns(3).Value
Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
For r = 1 To rCount
    uStr = CStr(uData(r, 1))
    If dict.Exists(uStr) Then
        If StrComp(CStr(vData(r, 1)), dict(uStr), vbTextCompare) <> 0 Then                                                 
            If urg Is Nothing Then
                Set urg = rg.Rows(r)
            Else
                Set urg = Union(urg, rg.Rows(r))
            End If
        End If
    Else
        dict(uStr) = CStr(vData(r, 1))
    End If
Next r

If Not urg Is Nothing Then
    rg.Interior.ColorIndex = xlNone
    urg.Interior.Color = X
End If

缺失的核心部分： #

• 没有读取B列的数据源，无法判断该行是否需要排除
• 循环过程中没有加入**判断B列值是否为“No”**的逻辑，导致所有行都参与了对比和标记

修正后的代码： #

Dim uData(), vData(), bData(), rg As Range, rCount As Long, X As Variant
Dim urg As Range, r As Long, uStr As String, i As Integer
Dim dict As Object
X = RGB(200, 205, 5)

With Sheets("Data")
    With Intersect(.UsedRange, .Range("A15:C2000"))
        rCount = .Rows.Count
        Set rg = .Resize(rCount)
    End With
End With

' 新增读取B列数据的数组
uData = rg.Columns(1).Value
vData = rg.Columns(3).Value
bData = rg.Columns(2).Value

Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare

For r = 1 To rCount
    ' 新增判断：如果B列当前行值为"No"，直接跳过该行的处理
    If CStr(bData(r, 1)) = "No" Then
        GoTo SkipRow
    End If
    
    uStr = CStr(uData(r, 1))
    If dict.Exists(uStr) Then
        If StrComp(CStr(vData(r, 1)), dict(uStr), vbTextCompare) <> 0 Then
            If urg Is Nothing Then
                Set urg = rg.Rows(r)
            Else
                Set urg = Union(urg, rg.Rows(r))
            End If
        End If
    Else
        dict(uStr) = CStr(vData(r, 1))
    End If
SkipRow:
Next r

If Not urg Is Nothing Then
    rg.Interior.ColorIndex = xlNone
    urg.Interior.Color = X
End If

修正说明： #

1. 新增了bData()数组来存储B列的所有数据
2. 在循环开头加入判断逻辑：如果当前行B列值为"No"，就通过GoTo SkipRow跳过后续的对比和标记操作，直接进入下一轮循环

内容的提问来源于stack exchange，提问作者Mo007