Look at the values ​​in column 1 and enter the values ​​of column 2

my dataset looks like

Col A   
A/05702; A/05724; A/05724;A/05724;A/05725;A/05725;
corresponding Col B
1;1;2;3;1;3;

I am trying to get results like

Col C
A/05702;A/5724;A05725

and related

 ColD1; 1,2,3; 1,3

This will look for the same values ​​in COLA, then if the found COLB values ​​go to COLD and are separated by a ","

Any help is appreciated.

0
source share
3 answers

You can definitely use the Dictionaryobject from the Microsoft Scripting Runtime script library. Add a link to your VBE using tools-> Links.

, . , , .

:

Option Explicit

Sub GenerateSummary()
    Dim wsSource As Worksheet
    Dim rngSource As Range
    Dim rngTarget As Range
    Dim lngRowCounter As Long
    Dim objData As New Dictionary
    Dim strKey As String, strValue As String

    'get source data
    Set wsSource = ThisWorkbook.Worksheets("Sheet2")
    Set rngSource = wsSource.Range("A1:B" & wsSource.Range("A1").CurrentRegion.Rows.Count)

    'analyse data
    For lngRowCounter = 1 To rngSource.Rows.Count
        'get key/ value pair
        strKey = rngSource.Cells(lngRowCounter, 1).Value
        strValue = rngSource.Cells(lngRowCounter, 2).Value
        'if key exists - add to value; else create new key/ value pair
        If objData.Exists(strKey) Then
            objData(strKey) = objData(strKey) & ", " & strValue
        Else
            objData.Add strKey, strValue
        End If
    Next lngRowCounter

    'output dictionary to target range
    'nb dictionary is zero-based index
    Set rngTarget = wsSource.Range("C1")
    For lngRowCounter = 1 To objData.Count
        rngTarget.Cells(lngRowCounter, 1).Value = objData.keys(lngRowCounter - 1)
        rngTarget.Cells(lngRowCounter, 2).Value = objData(objData.keys(lngRowCounter - 1))
    Next lngRowCounter

End Sub

Update

, . , Sheet2, , :

enter image description here

:

enter image description here

+3

UDF:

Function TEXTJOIN(delim As String, skipblank As Boolean, arr) As String
    Dim d
    For Each d In arr
        If d <> "" Or Not skipblank Then
            TEXTJOIN = TEXTJOIN & d & delim
        End If
    Next d
    TEXTJOIN = Left(TEXTJOIN, Len(TEXTJOIN) - 1)
End Function

, , .

:

=TEXTJOIN(",",TRUE,IF($A$1:$A$6 = $C1, $B$1:$B$6, ""))

Ctrl-Shift-Enter. , Excel {} .

enter image description here


Office 365, UDF , Excel, .


Alternative

, , , " ". C. C1 :

=IF(A2<>A1,B1,B1&"," &C2)

:

enter image description here

VLOOKUP , :

=VLOOKUP(E1,A:C,3,FALSE)

enter image description here

+2

vba, :

Row Values:    Col A  
Column Values: Col B  
Values: Min of Col B

enter image description here

UDF, , :

Function JoinWithComma(cells As Range)

    Dim cell As Range, result As String

    For Each cell In cells
        If cell.Value <> "" Then
            result = result & cell.Value & ", "
        End If
    Next cell

    If Len(result) > 2 Then
        JoinWithComma = Left(result, Len(result) - 2)
    Else
        JoinWithComma = ""
    End If

End Function

enter image description here

0
source

Source: https://habr.com/ru/post/1665908/


All Articles