nebenliegende Zellen vergleichen

Hallo,
irgendwie stehe ich grade bissel aufm Schlauch.
Ich habe vor mit VBA in Spalte A:A nach den Werten zu suchen und dann die nebenliegenden Zellen (B:B) zu merken und mit den weiteren Fundstellen zuvergleichen, so dass ich halt keine Dubletten bekomme. Autofilter ist leider nicht möglich, da die Suchergebnisse teilweise zu mehreren Suchbegriffen zugeordnet werden.
Im folgenden Beispielbild wäre das eine Suche nach "a" und als Ergebnis würde ich "aaa" "fff" und "zzz" erhalten. Das Doppelte Suchergebnis "aaa" würde nicht mehr auftauchen. (Das Ausgabefeld würde ich gerne mehrzeilig formatieren. Das kann ich dann aber später selber bewerkstelligen.)
Nur zur Info: In der richtigen Tabelle sind die Suchbegriffe teilweise 100fach vorhanden und es werden so max. 20 Suchergebnisse rauskommen.
Mir fehlt der Ansatz, wie ich die Dubletten bei den Suchergebnissen vermeide UND die bereinigten Suchergebnisse für eine finale Ausgabe in die Zielzellen in einen beliebig grossen Zwischenspeicher schreibe. Nachdem alle Fundstellen vorhanden sind, müssten die Suchergebnisse im Zwischenspeicher einmal durchgezählt und in die Zielzelle(n) geschrieben werden.
Falls überhaupt jemand verstanden hat, was ich meine, hoffe ich auf eine leichte verständliche Antwort. Danke!
Userbild

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Function SuchenVerketten(strSuchwert As String, _ rngSuchBereich As Range, intOffset As Integer) Dim strAusgabe As String, c As Range Dim firstAddress As String With rngSuchBereich Set c = .Find(strSuchwert, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do strAusgabe = strAusgabe & c.Offset(0, intOffset).Text & vbLf Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With SuchenVerketten = strAusgabe End Function

Sub Suchen() Dim I As Long, J As Long, wks As Worksheet, Finden, Ergebnis(), Text Dim doppelt As Boolean, Zeile As Integer Set wks = Worksheets("Tabelle1") 'Tabellenblatt in dem gesucht werden soll Finden = wks.Range("D21").Value 'in Spalte A gesuchter Wert Zeile = 0 Text = "nichts gefunden" With wks For I = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row If .Cells(I, "A") = Finden Then If Zeile = 0 Then Zeile = Zeile + 1 ReDim Ergebnis(1 To Zeile) Ergebnis(Zeile) = .Cells(I, "B") Text = Ergebnis(Zeile) Else doppelt = False For J = 1 To UBound(Ergebnis) If .Cells(I, "B") = Ergebnis(J) Then doppelt = True Exit For End If Next J If doppelt = False Then Zeile = Zeile + 1 ReDim Preserve Ergebnis(1 To Zeile) Ergebnis(Zeile) = .Cells(I, "B") End If End If End If Next I End With 'Ergebnisse in einer Variablen zusammenfassen If Text <> "nichts gefunden" Then If UBound(Ergebnis) > 1 Then For I = 2 To UBound(Ergebnis) Text = Text & Chr$(10) & Ergebnis(I) Next I End If End If wks.Range("E21").Value = Text End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread