Verketten nach kriterium mit VBA

0 Punkte
197 Aufrufe
Gefragt 10, Jan 2017 in Tabellenkalkulation von BertiBohne
Hallo zusammen,

ich habe ein Problem. da ich absoluter Anfänger im Bereich VBA bin,
brauche ich ein wenig Hilfe. Es sind knapp 2000 Zeilen und das ist
von Hand ein wenig viel....
In meiner Tabelle habe ich folgenden Aufbau

Spalte 1 Spalte 2
A X
Y
Z
B W
D
K

und so soll es hinterher aussehen:

Spalte 1 Spalte 2
A XYZ
B WDK


ich hoffe ich habe es anschaulich genug dargstellt. Ich hoffe ihr könnt
mir helfen.

Gruß Berti

2 Antworten

0 Punkte
Beantwortet 10, Jan 2017 von BertiBohne
ok die Formatierung hat es ein wenig zerlegt.....


Spalte 1 Spalte 2
A________X
_________Y
_________Z
B________W
_________K
_________D

so soll es aussehen...

Spalte 1 Spalte 2
A________XYZ
B________WKD
0 Punkte
Beantwortet 10, Jan 2017 von m-o Nutzer (9,991 Punkte)
Hallo,

ich gehe mal davon aus, dass A und B etc in der Spalte A stehen und die anderen Buchstaben in Spalte B. Außerdem stehen diese immer in eigenen Zeilen und es gibt keine Überschriften (falls doch, ist das folgende Makro entsprechend anzupassen).
Die zusammengefassten Daten werden unter der bestehenden Tabelle ausgegeben. Das folgende Makro gehört in ein Standard-Modul der entsprechenden Arbeitsmappe:

Sub zusammenfassen()

Dim lngLetzte As Long
Dim varSuch As Variant
Dim arrErgebnis As Variant
Dim lngAnzahl As Long
Dim lngZeile As Long
Dim strZusammen As String
Dim lngZaehler As Long

With ActiveSheet
'letzte Zeile in Spalte B ermitteln
lngLetzte = .Cells(Rows.Count, 2).End(xlUp).Row

'Anzahl der nicht leeren Zellen in Spalte A ermitteln
lngAnzahl = Application.WorksheetFunction.CountA(.Range(.Cells(1, 1), .Cells(lngLetzte, 1)))

'Feld für Zusammenfassung Re-Dimensionieren
ReDim arrErgebnis(lngAnzahl, 1)

'Daten für 1. Zeile einlesen
varSuch = .Cells(1, 1).Value
strZusammen = .Cells(1, 2).Value

'Schleife für das Zusammenfassen
For lngZeile = 2 To lngLetzte
'Prüfen, ob Spalte A leer ist
If IsEmpty(.Cells(lngZeile, 1)) = True Then
'falls ja, dann Inhalt von Spalte B an String hängen
strZusammen = strZusammen & .Cells(lngZeile, 2).Value
Else
'falls nein, dann gesammelte Daten in Array schreiben
arrErgebnis(lngZaehler, 0) = varSuch
arrErgebnis(lngZaehler, 1) = strZusammen
lngZaehler = lngZaehler + 1
'und neue Zusammenfassung beginnen
varSuch = .Cells(lngZeile, 1).Value
strZusammen = .Cells(lngZeile, 2).Value
End If
Next lngZeile

'nach Durchlauf der Schleife, letzte Daten in Array schreiben
arrErgebnis(lngZaehler, 0) = varSuch
arrErgebnis(lngZaehler, 1) = strZusammen

'Zusammengefasste Daten unterhalb der bestehenden Daten ausgeben
.Range(.Cells(lngLetzte + 2, 1), .Cells(lngLetzte + 2 + UBound(arrErgebnis) - 1, 2)) = arrErgebnis

End With

End Sub


Gruß

M.O.
...