重复值的循环函数

Question

我希望你能帮助我并为我指明正确的方向， 有没有办法使用循环函数返回列表中每个重复值的值？ 我是 VBA 新手，目前正在尝试在包含重复值的列中找到循环函数的最佳方法。

我希望我的 for 循环检查列中的每个重复值并在辅助工作表中返回其分配的值。

例如我的数据包括：

BP                 BP Code     Part number      Entry Date
Wess               BP0001      123534           6/18/2024
Dupl               BP0003      11123            6/18/2024
Wess               BP0001      113              6/01/2024
Wess               BP0001      23123            1/01/2022
SSm                BP0002      12223            1/01/2022

等等； BP和BP代码“Wess”和“BP0001”是我的主要目标，并将在专栏中重复多次；我需要的返回值是“零件号”和“进入日期”

我尝试过以下代码：

Sub match_Data()

Dim rSH As Worksheet
Dim sSh As Worksheet
Set rSH = ThisWorkbook.Sheets("data")
Set sSh = ThisWorkbook.Sheets("Search Data")

Dim Bpartner As String, Pcode As String

  For a = 2 To sSh.Range("A" & Rows.Count).End(xlUp).Row
    Bpartner = sSh.Range("A" & a).Value
    Pcode = sSh.Range("B" & a).Value
    
    For b = 2 To rSH.Range("AQ" & Rows.Count).End(xlUp).Row
      If rSH.Range("AQ" & b).Value = Bpartner And rSH.Range("AP" & b).Value = Pcode Then
            
        sSh.Range("C" & a).Value = rSH.Range("AS" & b).Value
        sSh.Range("D" & a).Value = rSH.Range("AI" & b).Value
        sSh.Range("E" & a).Value = rSH.Range("AV" & b).Value
        sSh.Range("F" & a).Value = rSH.Range("AZ" & b).Value
        sSh.Range("G" & a).Value = rSH.Range("BA" & b).Value
            
        Exit For
      End If
    Next b
  Next a

End Sub

但现在代码仅返回列中找到的第一个重复值的值。 我正在尽力解释，但如果没有，请告诉我，我希望你能帮助我。

Answer 1

如果您需要能够引用多个匹配行，您可以将每个值附加到“搜索”表上每个单元格中的任何现有内容：

Sub match_Data()

    Dim rSH As Worksheet, sSh As Worksheet, a As Long, b As Long
    Dim Bpartner As String, Pcode As String
    
    Set rSH = ThisWorkbook.Sheets("data")
    Set sSh = ThisWorkbook.Sheets("Search Data")
    
    For a = 2 To sSh.Range("A" & Rows.Count).End(xlUp).Row
        Bpartner = sSh.Range("A" & a).Value
        Pcode = sSh.Range("B" & a).Value
        
        For b = 2 To rSH.Range("AQ" & Rows.Count).End(xlUp).Row
            With rSH.Rows(b)
                If .Range("AQ1").Value = Bpartner Then 'AQ1 is *relative* to Rows(b)...
                    If .Range("AP1").Value = Pcode Then
                        AddValue sSh.Range("C" & a), .Range("AS1").Value
                        AddValue sSh.Range("D" & a), .Range("AI1").Value
                        AddValue sSh.Range("E" & a), .Range("AV1").Value
                        AddValue sSh.Range("F" & a), .Range("AZ1").Value
                        AddValue sSh.Range("G" & a), .Range("BA1").Value
                    End If
                End If
            End With
        Next b
    Next a

End Sub

'Append value `addThis` to any existing value in `c`
Sub AddValue(c As Range, ByVal addThis)
    Dim v
    If Len(addThis) = 0 Then addThis = "[empty]" 'default for empty values
    v = c.Value 'read existing value
    c.Value = v & IIf(Len(v) > 0, vbLf, "") & addThis
End Sub