VBA Begriff suchen, merken auflisten

Hallo zusammen,
ich komme gerade null weiter und hoffe das mir hier jemand helfen kann. Es ist auch schwer mein Problem zu beschreiben deswegen habe ich eine Beispieldatei angehängt.
Ich möchte in der Spalte E nach einer nicht leeren Zelle suchen und anschließend den Wert aus der Spalte F merken. Der Wert aus der Zelle E soll auch gemerkt werden und ist mein Suchbegriff für die Spalte D. Wenn der Suchbegriff in der Spalte D gefunden wird soll der Wert in der gleichen Zeile aus der Spalte F mit dem aus der vorangegangen F verbunden werden und in die Spalte G eingetragen werden. In der Spalte H steht das theoretische Ergebnis das ich sehen möchte. Bis jetzt schaffe ich es nur mir das erste F zu merken und nach dem nächsten D zu suchen.
Um es kurz zusagen ich möchte eine Vorgangskette erstellen die mal länger oder kürzer sein kann.
https://www.herber.de/bbs/user/140607.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub RechteckabgerundeteEcken2_Klicken() Dim ZeileA As Integer Dim ZeileB As Integer Dim Suchspalte As Long Dim Erg As String Dim Zelle As Range Suchspalte = 4 For ZeileA = 4 To Range("e20").End(xlUp).Row If Cells(ZeileA, 5) 0 Then ZeileB = ZeileA Erg = Cells(ZeileB, 6).Value Do Set Zelle = Range(Cells(4, Suchspalte), Cells(ZeileB, Suchspalte)).Find(whAT:= _ Cells(ZeileB, 5), searchdirection:=xlPrevious) If Zelle Is Nothing Then Exit Do ZeileB = Zelle.Row Erg = Erg & "; " & Cells(ZeileB, 6) Loop Cells(ZeileA, 7) = Erg End If Next ZeileA End Sub

na dann hau ich auch mal was raus.

Sub RechteckabgerundeteEcken2_Klicken()
Dim ZeileA As Integer
Dim lFundE, lFundERow
Dim f As Range
Dim ergebnis As String, alleFunde As String
For ZeileA = Range("e20").End(xlUp).Row To 4 Step -1
If Not IsEmpty(Cells(ZeileA, "E")) Then
lFundE = Cells(ZeileA, "E").Value
lFundERow = ZeileA
ergebnis = Cells(ZeileA, "F").Value
Do
Set f = Range("D4:D" & Cells(Rows.Count, "d").End(xlUp).Row).Find(lFundE, LookIn: _
=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
If Len(alleFunde) > 0 Then
If True = isInString(alleFunde, CStr(f.Offset(, 2).Value)) Then
Exit Do
End If
End If
ergebnis = ergebnis & ";" & f.Offset(, 2)
lFundE = f.Offset(, 1).Value
Else
Cells(lFundERow, "G") = ergebnis
alleFunde = alleFunde & ";" & ergebnis
Exit Do
End If
Loop While ZeileA > 4
End If
Next ZeileA
End Sub
Function isInString(s As String, such As String) As Boolean
Dim x
isInString = False
For Each x In Split(s, ";")
If x = such Then isInString = True
Next
End Function

Beliebteste Forumthreads (12 Monate)

VBA Begriff suchen, merken auflisten

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Begriff suchen, merken auflisten

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread