Microsoft Excel

Herbers Excel/VBA-Archiv

Zelleninhalt suchen und Spalten daneben ausgeben


Betrifft: Zelleninhalt suchen und Spalten daneben ausgeben
von: Sandro I
Geschrieben am: 19.12.2018 12:07:18

Hallo,

folgender automatisierter Wunsch besteht. (Wenn nötig via vba)

Tabelle 1 = Fahrtenbuch
Tabelle 2 = Fortlaufende eindeutige Kundenliste mit entsprechenden Infos

Folgenden funktionierenden Code habe ich bereits gefunden.
Dieser sucht via Msgbox in Tabelle 2 die eingegebene Kundennummer und überträgt die neben dem Treffer in Tabelle 2 stehenden Spalten, in Zeile 3 der Tabelle 1.
Nun überschreibt er jedoch beim 2. Aufruf die Werte in der Zeile 3 Tabelle 1.
Ich möchte jedoch fortlaufende Einträge vornehmen. Es soll quasi immer die nächste (leere) Zeile gefüllt werden.
Kann mir jemand sagen wir ich aus "AbZZeile = 3" beim nächsten msgbox Aufruf "AbZZeile = 4" bekomme?
Vielen Dank

Sub Filtern()
Quelle = "Tabelle1" 'Name der Tabelle mit den Quelldaten
QSpalte = "B" 'Spalte, in welcher gesucht wird
Spaltenanzahl = 2 'Anzahl daneben liegender Spalten, aus denen die Inhalte in die Zieldatei ü _
bertragen werden sollen
 
Ziel = "Tabelle2" 'Tabellenname für gefilterte Daten
AbZZeile = 2 'Eintragen der gefilterten Daten ab dieser Zeile
ZSpalte = "A" 'Eintragen der gefilterten Daten ab dieser Spalte
 
Do Until Suche <> "" 'keine leere Eingabe akzeptieren
    Suche = InputBox("Bitte den Suchbegriff eingeben (oder mit Eingabe von 'Ende' abbrechen):",  _
 _
"Suchbegriff")
Loop
If LCase(Suche) = "ende" Then Exit 

Sub 'Abbruch
 
Set Q = Worksheets(Quelle)
Set Z = Worksheets(Ziel)
ZZeile = AbZZeile 'Startzeile in Zieldatei setzen
 
With Q.Columns(QSpalte)
    Set Gefunden = .Find(Suche, LookIn:=xlValues) 'gesamte Spalte der Quelldatei durchsuchen
    If Not Gefunden Is Nothing Then 'nur wenn der Suchbegriff auch gefunden wurde, die  _
folgenden Schritte durchführen
        Erste = Gefunden.Address 'erste Fundstelle merken
        Do 'für alle Fundstellen
            Z.Cells(ZZeile, ZSpalte).Resize(1, Spaltenanzahl) = Gefunden.Offset(0, 1).Resize(1,  _
 _
Spaltenanzahl).Value 'Werte der Nachbarzellen übertragen
            ZZeile = ZZeile + 1 'Zeilennummer der Zieltabelle erhöhen
            Set Gefunden = .FindNext(Gefunden) 'nächste Fundstelle suchen
        Loop Until Gefunden.Address = Erste 'bis wieder erste Fundstelle gefunden wird (= alle   _
_
erledigt)
    End If
End With
MsgBox "Fertig."
End Sub

  

Betrifft: AW: Zelleninhalt suchen und Spalten daneben ausgeben
von: Rudi Maintaire
Geschrieben am: 19.12.2018 12:14:37

Hallo,
statt ZZeile = AbZZeile
ZZeile=z.cells(rows.count,ZSpalte).end(xlup).row+1

Gruß
Rudi