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:
And then after running the macro, it looks like this:
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…