Suchen mit VBA, Zeilen auslassen

Hey,
mit folgendem Code suche ich in einem Bereich nach Werte und trage diese in ein Feld ein; hierbei ist aber sehr unpraktisch, dass bei mehreren passenden Werten in einer Zeile diese dann auch mehrfach in das Feld eingetragen werden. Wie muss ich den Code entsprechend anpassen?
Ich hatte überlegt, nach jeder Fundstelle einen Wert in Spalte G (dafür ist sie bereits berücksichtigt) einzutragen und bei der Suche auf diesen Wert zu prüfen: vorhanden = nicht eintragen, nicht vorhanden = eintragen. Allerdings weiß ich auch hier nicht, wie ich den Code anpassen müsste.


Set WkSh = ThisWorkbook.Sheets("Suchwerte")
With WkSh
Set rZelle = .Range("A2:G" & ersteZelleoDaten(Sheets("Suchwerte"), 1, 2) - 1).find(Me. _
txt_find.Value, LookAt:=xlPart, LookIn:=xlValues)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
Me.lbox_find.AddItem " "
Me.lbox_find.List(lLiBox, 0) = WkSh.Cells(rZelle.Row, 1).Value
Me.lbox_find.List(lLiBox, 1) = WkSh.Cells(rZelle.Row, 2).Value
Me.lbox_find.List(lLiBox, 2) = WkSh.Cells(rZelle.Row, 3).Value
Me.lbox_find.List(lLiBox, 3) = WkSh.Cells(rZelle.Row, 4).Value
Me.lbox_find.List(lLiBox, 4) = WkSh.Cells(rZelle.Row, 5).Value
lLiBox = lLiBox + 1
Set rZelle = .Cells.FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address  sFundst
End If
End With

Danke für Eure Hilfe!!!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Dim objSh As Worksheet, rng As Range, strFirst As String Dim lngRow() As Long, lngIndex As Long Redim lngRow(0) Set objSh = ThisWorkbook.Sheets("Suchwerte") With objSh Set rng = .Range("A2:G" & ersteZelleoDaten(Sheets("Suchwerte"), 1, 2) - 1).Find(txt_find.Value, LookAt:=xlPart, LookIn:=xlValues) If Not rng Is Nothing Then strFirst = rng.Address Do If IsError(Application.Match(rng.Row, lngRow, 0)) Then lbox_find.AddItem " " lbox_find.List(lngIndex, 0) = .Cells(rng.Row, 1).Value lbox_find.lbox_find.List(lngIndex, 1) = .Cells(rng.Row, 2).Value lbox_find.lbox_find.List(lngIndex, 2) = .Cells(rng.Row, 3).Value lbox_find.lbox_find.List(lngIndex, 3) = .Cells(rng.Row, 4).Value lbox_find.lbox_find.List(lngIndex, 4) = .Cells(rng.Row, 5).Value Redim Preserve lngro(lngIndex) lngRow(lngIndex) = rng.Row lngIndex = lngIndex + 1 End If Set rng = .Range("A2:G" & ersteZelleoDaten(Sheets("Suchwerte"), 1, 2) - 1).FindNext(rng) Loop While Not rng Is Nothing And rng.Address <> strFirst End If End With

With objSh Set rng = .Range("A2:G" & ersteZelleoDaten(Sheets("Suchwerte"), 1, 2) - 1).find(txt_find. _ Value, LookAt:=xlPart, LookIn:=xlValues) If Not rng Is Nothing Then strFirst = rng.Address Do If IsError(Application.Match(rng.Row, lngRow, 0)) Then Me.lbox_find.AddItem " " Me.lbox_find.List(lngIndex, 0) = .Cells(rng.Row, 1).Value Me.lbox_find.List(lngIndex, 1) = .Cells(rng.Row, 2).Value Me.lbox_find.List(lngIndex, 2) = .Cells(rng.Row, 3).Value Me.lbox_find.List(lngIndex, 3) = .Cells(rng.Row, 4).Value Me.lbox_find.List(lngIndex, 4) = .Cells(rng.Row, 5).Value ReDim Preserve lngRow(lngIndex) lngRow(lngIndex) = rng.Row lngIndex = lngIndex + 1 End If Set rng = .Range("A2:G" & ersteZelleoDaten(Sheets("Suchwerte"), 1, 2) - 1).FindNext(rng) Loop While Not rng Is Nothing And rng.Address strFirst End If End With

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread