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를 사용하여 시작 위치를 알 수 없습니다. 내 생각은 행을 통해 반복하고 모든 데이터를 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 

Answer 2

원하는 출력을 얻으려면이 사용자 정의 함수를 사용할 수 있습니다.

=CustomConcatenate($B$2:$C$6,B2) 

D2

에서 ... C6는,이 시도

을 :

Function CustomConcatenate(ByVal Rng As Range, ByVal Lookup As String) As String 
Dim str As String 
Dim cell As Range 
For Each cell In Rng.Columns(1).Cells 
    If cell = Lookup Then 
     If str = "" Then 
      str = cell.Offset(0, 1).Value 
     Else 
      str = str & "-" & cell.Offset(0, 1).Value 
     End If 
    End If 
Next cell 
CustomConcatenate = str 
End Function 

그런

는 샘플 데이터가 범위 B2에 가정하면 ... 다음과 같은 시트에서이 UDF를 사용

Answer 3

다음과 같은 사전 개체를 사용하여 원하는 결과를 얻을 수도 있습니다.

Public Sub ConcatOutput() 
Dim rg As Range 
Dim strOut As String 
Dim Key 
Application.ScreenUpdating = False 
With CreateObject("Scripting.Dictionary") 
    '\\ First Pass - Built List 
    .CompareMode = vbTextCompare 
    For Each rg In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row) 
     If .Exists(rg.Value) Then 
      .Item(rg.Value) = .Item(rg.Value) & "-" & rg.Offset(0, 1).Value 
     Else 
      .Add rg.Value, " (" & rg.Offset(0, 1).Value 
     End If 
    Next 
    '\\ Second Pass - Output to range of cells 
    For Each rg In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row) 
     rg.Offset(0, 2).Value = rg.Value & .Item(rg.Value) & ")" 
    Next 
End With 
Application.ScreenUpdating = True 
End Sub