Option
Explicit
Public
Sub
BlaBlub()
Dim
dic
As
Object
Dim
rngCell
As
Excel.Range
Dim
rngCellRef
As
Excel.Range
Dim
key
As
String
Dim
val
As
String
Set
rngCellRef = Range(
"A2"
)
Set
rngCell = rngCellRef.Offset(1)
Set
dic = CreateObject(
"Scripting.Dictionary"
)
Do
While
rngCell.Text <>
""
key = rngCell.Text
val = rngCell.Offset(, 2).Text
If
rngCell.Text <> rngCellRef.Text
Then
Set
rngCellRef = rngCell
End
If
If
Not
dic.Exists(key)
Then
Call
dic.Add(key, CreateObject(
"Scripting.Dictionary"
))
End
If
Call
dic(key).Add(dic(key).Count, val)
Set
rngCell = rngCell.Offset(1)
Loop
Dim
mnr
As
Variant
For
Each
mnr
In
dic
Debug.Print
"'"
; mnr;
"'"
,
" := "
; Join(dic(mnr).items,
"; "
)
Next
End
Sub