|
Mit dieser Daten-Tabelle als Beispiel : Spalte MNR muss sortiert vorliegen!
|
MNR |
KTXT |
SETMNR |
|
51-7498/41 |
|
89-3329/34 |
|
51-7498/41 |
|
61-4886/30 |
|
51-7498/41 |
|
97-2348/43 |
|
51-7498/41 |
|
65-2650/78 |
|
64-7901/28 |
|
77-3895/85 |
|
64-7901/28 |
|
37-3493/28 |
|
64-7901/28 |
|
16-8818/74 |
|
26-2238/71 |
|
38-2828/18 |
|
26-2238/71 |
|
85-4956/59 |
|
26-2238/71 |
|
67-1596/53 |
|
26-2238/71 |
|
20-2569/14 |
|
26-2238/71 |
|
10-8498/26 |
|
26-2238/71 |
|
99-4325/89 |
|
26-2238/71 |
|
36-5053/84 |
|
49-1650/62 |
|
24-9814/83 |
|
49-1650/62 |
|
84-5859/81 |
|
49-1650/62 |
|
33-4095/47 |
und dem Makro:
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") 'erste Daten-Zelle in Spalte MNR
Set rngCell = rngCellRef.Offset(1)
Set dic = CreateObject("Scripting.Dictionary")
Do While rngCell.Text <> ""
key = rngCell.Text 'MNR
val = rngCell.Offset(, 2).Text 'SETMNR ... Spalte MNR -> '2 nach rechts' -> Spalte SETMNR
If rngCell.Text <> rngCellRef.Text Then
'MNR hat sich geändert!
Set rngCellRef = rngCell
End If
'sicherstellen, dass MNR in der Liste existiert
'und initialisiert ist
If Not dic.Exists(key) Then
Call dic.Add(key, CreateObject("Scripting.Dictionary"))
End If
'SETMNR zuorden zu MNR
Call dic(key).Add(dic(key).Count, val)
'nächste Zelle
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
kommt man dann zu dieser Ausgabe:
'51-7498/41' := 61-4886/30; 97-2348/43; 65-2650/78
'64-7901/28' := 77-3895/85; 37-3493/28; 16-8818/74
'26-2238/71' := 38-2828/18; 85-4956/59; 67-1596/53; 20-2569/14; 10-8498/26; 99-4325/89; 36-5053/84
'49-1650/62' := 24-9814/83; 84-5859/81; 33-4095/47
Anstatt die Ausgabe wie hier ins Direktfenster zu schreiben, schreibst du das dann halt in Spalte F.
Deinen Code habe ich nur überflogen, aber nicht weiter angesehen - sieht zudem nach Makro-Rekorder aus... was zumindest den Job erledigen sollte.
Grüße
|