Microsoft Excel

Herbers Excel/VBA-Archiv

VBA Suchen-Verarbeiten-Einsetzen

Betrifft: VBA Suchen-Verarbeiten-Einsetzen von: xtian
Geschrieben am: 03.09.2020 12:49:42

Hallo zusammen,
ich bin VBA-Neuling und benötige einmal dringend für ein Makro eure Hilfe. Hier zum besseren Verständnis
einen kurzen Ausschnitt aus der Excelliste:

……….SpalteA.......SpalteB.......SpalteC.......SpalteD…
Zeile3...….P.......…...AAAA.........TextA
Zeile4...….L.....….....ÁAAA.........TextA
Zeile5...….K.......…..BBBB.........TextB...........AAAA-TextA-BBBB (Inhalte aus Zellen B4-C4-B5 zusammen)
Zeile6........K............CCCC.........TextC..........AAAA-TextA-CCCC (Inhalte aus Zellen B4-C4-B6 zusammen)
usw.

Das Makro soll zunächst in der SpalteA den Buchstaben K finden (Buchstabe K könnte theoretisch auch noch in
der Zeile 7 vorkommen!). Wird der Buchstabe K gefunden, ist der nächst höhere Buchstabe L in der Spalte A für
die weitere Aktion wichtig. Mit diesen Informationen soll das Makro jetzt in der Spalte D5 (in Zelle A5 wurde ja der
Buchstabe K gefunden) die Zelleninhalte aus den Zellen B4-C4-B5 verknüpfen. In der Spalte D6 (in Zelle A6
wurde ja der Buchstabe K gefunden) die Zelleninhalte aus den Zellen B4-C4-B6 verknüpfen.

Ich hoffe ich habe mein Vorhaben gut erklären können und hoffe auf eure Unterstützung.
Viele Grüße
Christian

Betrifft: Lad doch mal Musterdatei hoch
von: UweD
Geschrieben am: 03.09.2020 17:05:56



Betrifft: AW: Lad doch mal Musterdatei hoch
von: xtian
Geschrieben am: 03.09.2020 17:30:35

Hochladen funktioniert leider mit meinem PC nicht. Mein Beispiel ist nicht zu verstehen, oder?

Betrifft: AW: Lad doch mal Musterdatei hoch
von: UweD
Geschrieben am: 04.09.2020 11:39:45

Hallo

so?
Sub AAAA()
    Dim LR As Integer, i As Integer, Z1 As Integer
    Dim Last As Integer
    
    Z1 = 3 'erste Zeile
    LR = Cells(Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
    
    For i = Z1 To LR
        If Cells(i, 1) = "K" Then
            If Cells(i - 1, 1) <> "K" Then
                Last = i - 1
            End If
            Cells(i, 4) = Cells(Last, 2) & "-" & Cells(Last, 3) & "-" & Cells(i, 2)
        End If
        
    Next
End Sub

LG UweD

Betrifft: AW: Lad doch mal Musterdatei hoch
von: xtian
Geschrieben am: 04.09.2020 17:18:15

Hallo UweD,
wow, super, dass Makro funktioniert 1A. Vielen lieben Dank und ein schönes Wochenende.
Viele Grüße
Christian

Betrifft: Danke für die Rückmeldung (owT)
von: UweD
Geschrieben am: 09.09.2020 08:38:25