vba - 如果第一列中的值相同，则 Excel VBA 连接另一列中的值

Question

我的问题是，如果 B 列中的数据相同，我想连接 C 列中的数据。例如:

Column B     |     Column C
IXX          |     AI
IXX          |     BI
IYY          |     CI
IZZ          |     GI
IYY          |     TI

输出应该是:

Column D     
IXX (AI-BI)
IXX (AI-BI)
IYY (CI-TI)        
IZZ (GI)
IYY (CI-TI)

但是我不知道从哪里开始，使用vba。我的想法是 for 循环遍历行并将所有相同的数据与 B 列连接起来。

谢谢。

Answer 1

干得好。 XlFindAll 函数不是为此目的而定制的，只是定制的。因此它包含一些多余的代码。

Sub TestFindAll()
    ' 23 Dec 2017

    Dim Ws As Worksheet
    Dim Rng As Range                            ' range to search in
    Dim Matches As String
    Dim R As Long, Rl As Long

    Set Ws = ActiveSheet
    Application.ScreenUpdating = False
    With Ws
        Rl = .Cells(.Rows.Count, "B").End(xlUp).Row
        ' search items are in column B, starting in row 2
        Set Rng = Range(.Cells(2, "B"), .Cells(Rl, "B"))
        ' matches will be returned form the adjacent column
        ' however this can be adjusted in the XlFindAll function
        For R = 2 To Rl
            Matches = XlFindAll(Rng, .Cells(R, "B").Value)
            If Len(Matches) Then
                ' output to column D
                .Cells(R, "D").Value = .Cells(R, "B").Value & " (" & Matches & ")"
            End If
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

Function XlFindAll(Where As Range, _
                   ByVal What As Variant, _
                   Optional ByVal LookIn As Variant = xlValues, _
                   Optional ByVal LookAt As Long = xlWhole, _
                   Optional ByVal SearchBy As Long = xlByColumns, _
                   Optional ByVal StartAfter As Long, _
                   Optional ByVal Direction As Long = xlNext, _
                   Optional ByVal MatchCase As Boolean = False, _
                   Optional ByVal MatchByte As Boolean = False, _
                   Optional ByVal After As Range, _
                   Optional ByVal FindFormat As Boolean = False) As String
    ' 23 Dec 2017
    ' Settings LookIn, LookAt, SearchOrder, and MatchByte
    ' are saved each time the Find method is used

    Dim Fun() As String
    Dim Search As Range
    Dim Fnd As Range
    Dim FirstFnd As String
    Dim i As Long

    Set Search = Where
    With Search
        If After Is Nothing Then
            If StartAfter Then
                StartAfter = WorksheetFunction.Min(StartAfter, .Cells.Count)
            Else
                StartAfter = .Cells.Count
            End If
            Set After = .Cells(StartAfter)
        End If

        Set Fnd = .Find(What:=What, After:=After, _
                        LookIn:=LookIn, LookAt:=LookAt, _
                        SearchOrder:=SearchBy, SearchDirection:=Direction, _
                        MatchCase:=MatchCase, MatchByte:=MatchByte, _
                        SearchFormat:=FindFormat)
        If Not Fnd Is Nothing Then
            FirstFnd = Fnd.Address
            ReDim Fun(100)
            Do
                ' select the value in the adjacent cell on the same row
                Fun(i) = Fnd.Offset(0, 1).Value
                i = i + 1
                Set Fnd = .FindNext(Fnd)
            Loop While Not (Fnd Is Nothing) And (Fnd.Address <> FirstFnd)
        End If
    End With

    If i Then ReDim Preserve Fun(i - 1)
    XlFindAll = Join(Fun, "-")
End Function