1. Diese Seite verwendet Cookies. Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies. Weitere Informationen

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

Dieses Thema im Forum "Visual Basic 6.0, VBA & VBScript" wurde erstellt von marcertain, 20. März 2017.

  1. marcertain

    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:

  2. Yaslaw

    Yaslaw n/a Moderator

    Code (Visual Basic):
    1. Public Sub joinAccounts()
    2.     Dim ws As Worksheet
    3.     Dim codeRowNr As Long
    4.     Dim rowNr As Long
    5.     Dim accounts() As String
    6.     Dim accIdx As Long
    7.     Dim value As String
    8.    
    9.     Set ws = ActiveWorkbook.Worksheets("test")
    10.    
    11.     'Alle Zeilen duchackern
    12.    For rowNr = 1 To ws.UsedRange.Rows.Count
    13.         value = Trim(CStr(ws.Cells(rowNr, 1)))
    14.        
    15.         If value = "Code" Then
    16.         'Code-Blook beginnt
    17.            codeRowNr = rowNr           'Zeilennummer merken
    18.            Erase accounts              'Kontoliste leeren
    19.            accIdx = 0                  'KontoIndex zurücksetzen
    20.        ElseIf codeRowNr > 0 And value <> Empty Then
    21.         'Die Zeile enthält ein Konto.
    22.            ReDim Preserve accounts(i)  'Kontoliste proportienieren
    23.            accounts(accIdx) = value    'Konto in die Liste schreiben
    24.            accIdx = accIdx + accIdx    'KontoIndex eins hochzählen
    25.          
    26.         ElseIf codeRowNr > 0 Then
    27.         'Der Block ist fertig, Resultat auf Code-Zeile Schreiben
    28. WRITE_ACCOUNTS:
    29.             ws.Cells(codeRowNr, 2) = Join(accounts, ", ")
    30.             codeRowNr = 0
    31.         End If
    32.     Next rowNr
    33.    
    34.     'Sicherstellen, dass auch der letzte Block geschrieben wird
    35.    If codeRowNr > 0 Then GoTo WRITE_ACCOUNTS
    36. End Sub
    Viel Spass damit
     
Die Seite wird geladen...