Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
menu search
person
Welcome To Ask or Share your Answers For Others

Categories

my data set 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 the results as

Col C
A/05702;A/5724;A05725

and corresponding

 ColD1; 1,2,3; 1,3

This will look for same values in COLA, then if found COLB values goes to COLD and separated by ","

Any help is appreciated.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
883 views
Welcome To Ask or Share your Answers For Others

1 Answer

You can definitely leverage the Dictionary object from the Microsoft Scripting Runtime library. Add the the reference in your VBE with Tools->References.

Basically, a dictionary allows you to store values against a unique key. You also want to create a set of unique keys but keep appending to the value for that key as you encounter new rows for that key.

Here's the code:

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

For clarity, I will post screenshots of the data I entered to test this code. So, on my Sheet2 - which was a totally new and empty of any other data - I've got these entries:

enter image description here

And then after running the macro, it looks like this:

enter image description here


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
...