Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1672to1676
1672to1676
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

.Find-Funktion ähnliche Werte finden

Forumthread: .Find-Funktion ähnliche Werte finden

.Find-Funktion ähnliche Werte finden
05.02.2019 17:14:08
Tim
Hallo zusammen,
ich habe ein Makro mit dem ich eine Datenbank öffne, einen Wert darin via TextBox suche und mir "wenn gefunden", die dazugehörigen Werte zurückgeben lasse. Das funktioniert perfekt. Jetzt habe ich das Problem, dass ich nur eindeutige Werte finden kann. Sollten ähnliche Begriffe in der Datenbank sein, dann würde ich mir diese gern in eine Listbox geben lassen, um den richtigen Eintrag auswählen zu können.
Ziel ist es bei einem eindeutigen Wert die Daten zu übernehmen (funktioniert) und bei Mehrdeutigkeit alle gefunden Werte in eine Listbox geben.
Hintergrund ist, dass es einzelne Einträge in der Datenbank gibt die ähnlich lauten ohne, das Derjenige, der den Wert sucht, die genaue Bezeichnung kennt.
Wie muss man die .Find-Funktion dahingehend anpassen damit genau das funktioniert!?
Meine ersten Versuche habe ich mit CountIfs probiert jedoch entspricht das nicht ganz meiner Vorstellung.
Sub Datenbank_durchsuchen()
Dim wksDaten As Worksheet
Dim wkbDaten As Workbook
Dim rng As Range
On Error GoTo FEHLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Workbooks.Open "C:\Users\Test"
Set wkbDaten = Workbooks("Einträge.xlsx")
Set wksDaten = wkbDaten.Sheets("Datenbank")
If UserForm1.TextBox1  "" Then
Set rng = wksDaten.Columns(1).Find(What:=UserForm1.TextBox1, LookIn:=xlValues)
If WorksheetFunction.CountIfs(Worksheets("Datenbank").Columns(1), UserForm1.TextBox1) > 1 Then ' _
prüft ob der Suchwert mehr als einmal in der Liste auftaucht, wenn ja dann öffnet er die Userform2 und zeigt die Details an
MsgBox "Ja"
End If
If Not rng Is Nothing Then
UserForm1.TextBox2 = rng.Offset(0, 4)
End If
End If
wkbDaten.Close
FEHLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Anzeige

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 18:15:56
Nepumuk
Hallo Tim,
kannst du mal ein konkretes Beispiel für eine deiner Ähnlichkeiten geben?
Gruß
Nepumuk
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 18:25:47
Tim
Hi, ja klar:
Garage Nachbargebäude
Garage Nachbargebäude 1
Garage Nachbargebäude1
Garage Nachbargebäude_1
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 18:33:06
Daniel
Hi
Du kannst in Suchen/.Find die Jokerzeichen ? (Ein Zeichen) und * (beliebig viele Zeichen) verwenden und z.b. nach
Garage Nachbargeb*
Suchen.
Gruß Daniel
Anzeige
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 19:11:03
Nepumuk
Hallo Tim,
dann such mit dem Parameter: LookAt:=xlPart
Gruß
Nepumuk
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 19:49:12
Tim
Der Hinweis von Daniel war nicht schlecht, jedoch habe ich noch keine Möglichkeit gefunden eine If-Bedingung darüber zu legen.
Zudem habe ich mit LookAt:=xlPart gesucht.
=wenn Inhalt von Textbox ähnlich der Einträge in Datenbank, dann übernimm alle Daten die ähnlich sind und zeige sie mir in einer Listbox an.
Set rng = wksDaten.Columns(1).Find(What:=Veranstaltung, LookIn:=xlPart)
If rng größer als 1 Then MsgBox "ja"
Anzeige
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 20:44:08
onur
Hat nix mit deiner Frage direkt zu tun, aber:
Am Anfang jeder Sub pauschal 
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

ist Quatsch, zumal dein Makro keine einzige Zelle verändert.
Einzelne Zeilen davon benutzt man bewusst, um bestimmten Problemen des Codes wie Bildschirmflackern, Endlosschleifen usw vorzubeugen bzw sie zu verhindern.
Das Selbe gilt für Errortrapping - sollte man nur benutzen, wenn man wirklich einen bestimmten Fehler erwartet und diesen bestimmten Fehler abfangen will.
Aber nicht pauschal wie Aspirin gegen alle möglichen Wehwehchen, zumal du dann nicht mal bemerkst, DASS irgendein Fehler auftauchte, geschweige denn Welcher (evtl sogar ein ganz Anderer als erwartet).
Anzeige
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 20:55:59
Tim
Hallo Onur,
da meine Kenntnisse mit Makros sehr bescheiden sind, ist das was der Code hergibt, einfach mit meinem Wissen und Google zusammengeschustert. Von daher bin ich über deine Aussagen eher dankbar als das ich sie als Kritik verstehe.
Ich passe das umgehend an. Dennoch möchte ich gern erreichen, dass mein Suchbegriff aus der Textbox auch ähnliche Einträge in der Datenbank in einer Listbox zeigt.
Anzeige
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 20:59:56
onur
Hi Tim,
War ja uch nicht als Kritik sondern als Tip für die Zukunft gemeint.
Dann solltest du besser mal die Datei (oder eine genauso aufgebaute Beispielsdatei) posten, damit mann nicht alles unnötigerweise auch noch nachbauen muss.
Gruß
Onur
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 21:11:42
Werner
Hallo Tim,
hier mal mein Versuch (ohne deine Datei zu kennen).
Kombination aus Find bzw. Autofilter 
Option Explicit
Private Sub CommandButton1_Click()
Dim rng As Range, raListbox As Range, wksDaten As Worksheet
Dim loLetzte As Long, strSuchbegriff As String
Application.ScreenUpdating = False
'Blattname bitte an deine Verhältnisse anpassen
Set wksDaten = ThisWorkbook.Worksheets("Tabelle1")
'Listbox leeren
Me.ListBox1.Clear
With wksDaten
'Suchbegriff aus Textbox in Variable
strSuchbegriff = Me.TextBox1
'Suchbegriff nicht vorhanden Meldung
If WorksheetFunction.CountIf(.Columns(1), "*" & strSuchbegriff & "*") = 0 Then
MsgBox "Der Suchbegriff " & strSuchbegriff & " wurde nicht gefunden."
'Suchbegriff 1 x vorhanden Suchen mit Find und Ausgabe in Textbox2
ElseIf WorksheetFunction.CountIf(.Columns(1), "*" & strSuchbegriff & "*") = 1 Then
Set rng = wksDaten.Columns(1).Find(What:=strSuchbegriff, LookIn:=xlValues, lookat:= _
xlPart)
Me.TextBox2 = rng.Offset(0, 4)
'Suchbegriff mehrfach vorhanden
Else
'letzte belegte Zeile in Spalte A ermitteln
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
'Autofilter auf A1:E letzte belegte Zeile
.Range("A1:E" & loLetzte).AutoFilter
'Bereich nach Suchbegriff filtern
.Range("$A$1:$E$" & loLetzte).AutoFilter Field:=1, Criteria1:="*" & strSuchbegriff & "*" _
'Filterergebnis kopieren nach J1
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Columns(1).Copy .Cells(1, 10)
End With
'Autofilter raus
.AutoFilterMode = False
'letzte belegte Zeile in Spalte J ermitteln
loLetzte = .Cells(.Rows.Count, 10).End(xlUp).Row
'Bereich J1:J letzte belegte Zeile in Listbox einlesen
Me.ListBox1.List = .Range(.Cells(1, 10), .Cells(loLetzte, 10)).Value
'Spalte J leeren
.Columns(10).ClearContents
End If
End With
Set wksDaten = Nothing: Set rng = Nothing
End Sub
Gruß Werner
Anzeige
AW: .Find-Funktion ähnliche Werte finden
05.02.2019 21:40:59
Werner
Hallo Tim,
hier jetzt noch eine Version, bei der auch die "Hilfsspalte" in die das Filterergebnis zwischengespeichert wird, im Code ermittelt wird.
Zudem dann noch ein Makro für das Doppelklick_Event der Listbox. Doppelklick auf den richtigen Suchbegriff gibt dann den Wert aus .offset(, 4) in Textbox2 aus. 
Option Explicit
Private Sub CommandButton1_Click()
Dim rng As Range, raListbox As Range, wksDaten As Worksheet
Dim loLetzte As Long, loSpalte As Long, strSuchbegriff As String
Application.ScreenUpdating = False
Set wksDaten = ThisWorkbook.Worksheets("Tabelle1")
Me.ListBox1.Clear
With wksDaten
strSuchbegriff = Me.TextBox1
If WorksheetFunction.CountIf(.Columns(1), "*" & strSuchbegriff & "*") = 0 Then
MsgBox "Der Suchbegriff " & strSuchbegriff & " wurde nicht gefunden."
ElseIf WorksheetFunction.CountIf(.Columns(1), "*" & strSuchbegriff & "*") = 1 Then
Set rng = wksDaten.Columns(1).Find(What:=strSuchbegriff, LookIn:=xlValues, lookat:= _
xlPart)
Me.TextBox2 = rng.Offset(0, 4)
Else
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).Column
.Range("A1:A" & loLetzte).AutoFilter
.Range("$A$1:$A$" & loLetzte).AutoFilter Field:=1, Criteria1:="*" & strSuchbegriff & "*" _
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy .Cells(1, loSpalte)
End With
.AutoFilterMode = False
loLetzte = .Cells(.Rows.Count, loSpalte).End(xlUp).Row
Me.ListBox1.List = .Range(.Cells(1, loSpalte), .Cells(loLetzte, loSpalte)).Value
.Columns(loSpalte).ClearContents
End If
End With
Set wksDaten = Nothing: Set rng = Nothing
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim strSuchbegriff As String, rng As Range, wksDaten As Worksheet
Application.ScreenUpdating = False
Set wksDaten = Worksheets("Tabelle1")
strSuchbegriff = Me.ListBox1
Me.ListBox1.Clear
With wksDaten
Set rng = wksDaten.Columns(1).Find(What:=strSuchbegriff, LookIn:=xlValues, lookat:=xlWhole)
Me.TextBox2 = rng.Offset(0, 4)
End With
Set rng = Nothing
End Sub
Gruß Werner
Anzeige
AW: .Find-Funktion ähnliche Werte finden
06.02.2019 13:06:40
Tim
Hallo Onur, Hallo Werner,
vielen Dank für die beiden Vorschläge, welche sehr gut funktionieren und meinen Vorstellungen entsprechen. Mit meinen Kenntnissen habe ich bisher nur Werners Vorschlag soweit anpassen können, dass er auf eine externe Quelle zugreifen kann, wobei mir die Code-Länge von Onur besser gefällt.
Hier mal meine Anpassung:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim wksDaten As Worksheet, rng As Range, raListbox As Range
Dim wkbDaten As Workbook
Dim loLetzte As Long, loSpalte As Long, strSuchbegriff As String
Application.ScreenUpdating = False
On Error GoTo FEHLER
Workbooks.Open "C:\Desktop\Testprogramm\Test.xlsx"
Set wkbDaten = Workbooks("Test.xlsx")
Set wksDaten = wkbDaten.Sheets("Tabelle1")
Me.ListBox1.Clear
With wksDaten
strSuchbegriff = Me.TextBox1
If WorksheetFunction.CountIf(.Columns(1), "*" & strSuchbegriff & "*") = 0 Then
MsgBox "Der Suchbegriff " & strSuchbegriff & " wurde nicht gefunden."
ElseIf WorksheetFunction.CountIf(.Columns(1), "*" & strSuchbegriff & "*") = 1 Then
Set rng = wksDaten.Columns(1).Find(What:=strSuchbegriff, LookIn:=xlValues, lookat:= _
xlPart)
Me.TextBox2 = rng.Offset(0, 4)
Else
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).Column
.Range("A1:A" & loLetzte).AutoFilter
.Range("$A$1:$A$" & loLetzte).AutoFilter Field:=1, Criteria1:="*" & strSuchbegriff & "*" _
_
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy .Cells(1, loSpalte)
End With
.AutoFilterMode = False
loLetzte = .Cells(.Rows.Count, loSpalte).End(xlUp).Row
Me.ListBox1.List = .Range(.Cells(1, loSpalte), .Cells(loLetzte, loSpalte)).Value
.Columns(loSpalte).ClearContents
End If
End With
Set wksDaten = Nothing: Set rng = Nothing
wkbDaten.Close savechanges:=False
FEHLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim strSuchbegriff As String, rng As Range, wksDaten As Worksheet
Dim wkbDaten As Workbook
On Error GoTo FEHLER
Application.ScreenUpdating = False
Workbooks.Open "C:\Desktop\Testprogramm\Test.xlsx"
Set wkbDaten = Workbooks("Test.xlsx")
Set wksDaten = wkbDaten.Sheets("Tabelle1")
strSuchbegriff = Me.ListBox1
Me.ListBox1.Clear
With wksDaten
Set rng = wksDaten.Columns(1).Find(What:=strSuchbegriff, LookIn:=xlValues, lookat:=xlWhole)
Me.TextBox2 = rng.Offset(0, 3)
End With
Set rng = Nothing
wkbDaten.Close savechanges:=False
FEHLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Anzeige
;
Anzeige
Anzeige

Infobox / Tutorial

.Find-Funktion für ähnliche Werte in Excel nutzen

Schritt-für-Schritt-Anleitung

  1. Makro erstellen: Öffne den Visual Basic for Applications (VBA)-Editor in Excel (Alt + F11) und erstelle ein neues Modul.

  2. Code eingeben: Füge den folgenden Code ein, um die .Find-Funktion für die Suche nach ähnlichen Werten zu verwenden:

    Sub Datenbank_durchsuchen()
   Dim wksDaten As Worksheet
   Dim rng As Range
   Set wksDaten = ThisWorkbook.Sheets("Tabelle1")
   Dim strSuchbegriff As String

   strSuchbegriff = UserForm1.TextBox1.Value
   Me.ListBox1.Clear

   If WorksheetFunction.CountIf(wksDaten.Columns(1), "*" & strSuchbegriff & "*") > 0 Then
       Set rng = wksDaten.Columns(1).Find(What:=strSuchbegriff, LookIn:=xlValues, LookAt:=xlPart)
       If Not rng Is Nothing Then
           ' Hier kannst du alle ähnlichen Werte in die Listbox hinzufügen
           ' Beispiel: Me.ListBox1.AddItem rng.Value
       End If
   End If
End Sub

  3. UserForm erstellen: Erstelle ein UserForm mit einer TextBox (TextBox1) für die Eingabe des Suchbegriffs und einer ListBox (ListBox1) zur Anzeige der gefundenen ähnlichen Werte.

  4. Makro verknüpfen: Verknüpfe das Makro mit einem Button im UserForm, sodass beim Klicken das Programm die Suche ausführt.

Häufige Fehler und Lösungen

  • Fehler: Keine ähnlichen Werte gefunden: Stelle sicher, dass die Eingabewerte in der TextBox korrekt sind und dass das Suchkriterium mit den Werten in der Datenbank übereinstimmt.

  • Lösung: Verwendung von Wildcards: Nutze * und ? in deinem Suchbegriff, um mehr Flexibilität zu haben. Beispiel: Garage Nachbargeb*.

Alternative Methoden

  • Verwendung von Autofilter: Anstelle der .Find-Funktion kannst du auch den Autofilter verwenden, um ähnliche Werte in einer Spalte zu filtern und diese in einer ListBox anzuzeigen. 

    With wksDaten
  .Range("A1:A" & loLetzte).AutoFilter Field:=1, Criteria1:="*" & strSuchbegriff & "*"
  ' Anschließend die gefilterten Werte in die ListBox übertragen
End With

Praktische Beispiele

  • Beispiel-Daten: Angenommen, du hast folgende Werte in deiner Datenbank:

    • Garage Nachbargebäude
    • Garage Nachbargebäude 1
    • Garage Nachbargebäude1
    • Garage Nachbargebäude_1

    Wenn du "Garage Nachbargeb" in die TextBox eingibst, solltest du alle ähnlichen Einträge in der ListBox sehen.

Tipps für Profis

  • Optimierung des Codes: Reduziere die Anzahl der Bildschirmaktualisierungen, indem du Application.ScreenUpdating = False am Anfang und Application.ScreenUpdating = True am Ende deiner Sub-Prozedur verwendest.

  • Erweiterte Suchkriterien: Experimentiere mit dem Parameter LookAt in der .Find-Funktion. LookAt:=xlPart findet Teilübereinstimmungen und kann dazu beitragen, mehr ähnliche Werte zu finden.

FAQ: Häufige Fragen

1. Wie kann ich sicherstellen, dass alle ähnlichen Werte gefunden werden? Nutze Wildcards in deinem Suchbegriff und setze LookAt:=xlPart in der .Find-Funktion.

2. Was ist der Unterschied zwischen .Find und Autofilter? Die .Find-Funktion sucht nach einem spezifischen Wert oder Muster, während Autofilter eine gesamte Liste basierend auf bestimmten Bedingungen filtert. Beides kann effektiv sein, um ähnliche Werte in Excel zu finden.

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige