VB - Excel: Zellen über die Überschrift in Zeilen identifizieren und verketten bzw. verbinden

marcertain

Grünschnabel
Hallo Zusammen,

wie kann ich mittels VB in den Zeilen nach einer bestimmten Überschrift suchen ("Code:") und die Kontennummern, die drunter hängen, in eine Zelle bringen( es gilt pro Filter)? D.h. hier wäre die Funktion "verketten" oder "verbinden" relevant.
Bei den diversen Filtern handelt es sich um verschiedene Anzahl der drunter hängenden Konten. D.h. es müssen nur die "aktiven" Zellen unter den Überschriften "Codes" verbunden werden.
Die Tabelle hat ein paar hundert Tausend Zeilen, die wahrscheinlich über die Formel nicht abgedeckt werden können.
Herzlichen Dank im Voraus für die Ideen!

Beste Grüße
Maria
 

Anhänge

  • test.xlsx
    11 KB · Aufrufe: 1
Visual Basic:
Public Sub joinAccounts()
    Dim ws As Worksheet
    Dim codeRowNr As Long
    Dim rowNr As Long
    Dim accounts() As String
    Dim accIdx As Long
    Dim value As String
   
    Set ws = ActiveWorkbook.Worksheets("test")
   
    'Alle Zeilen duchackern
    For rowNr = 1 To ws.UsedRange.Rows.Count
        value = Trim(CStr(ws.Cells(rowNr, 1)))
       
        If value = "Code" Then
        'Code-Blook beginnt
            codeRowNr = rowNr           'Zeilennummer merken
            Erase accounts              'Kontoliste leeren
            accIdx = 0                  'KontoIndex zurücksetzen
        ElseIf codeRowNr > 0 And value <> Empty Then
        'Die Zeile enthält ein Konto.
            ReDim Preserve accounts(i)  'Kontoliste proportienieren
            accounts(accIdx) = value    'Konto in die Liste schreiben
            accIdx = accIdx + accIdx    'KontoIndex eins hochzählen
           
        ElseIf codeRowNr > 0 Then
        'Der Block ist fertig, Resultat auf Code-Zeile Schreiben
WRITE_ACCOUNTS:
            ws.Cells(codeRowNr, 2) = Join(accounts, ", ")
            codeRowNr = 0
        End If
    Next rowNr
   
    'Sicherstellen, dass auch der letzte Block geschrieben wird
    If codeRowNr > 0 Then GoTo WRITE_ACCOUNTS
End Sub

Viel Spass damit
 
Zurück