per Makro Tabelle durchsuchen und Ergebnis ausgeben

Question

Guten Morgen,

ich stehe mal wieder (dank Makro) total auf dem "Schlauch" - ich weiss genau was ich machen will, bekomme es aber einfach nicht hin.....

Mein Problem:
Ich habe eine Tabelle mit Kundendaten, in diese möchte ich nun eine Suchfunktion einbauen, die abfragt ob der Kunde bereits angelegt ist.

Die Tabelle enthält ab B9 die Nachnamen, ab C9 die Vornamen

Zum suchen möchte ich folgende Felder verwenden:
in C4 würde ich den Nachnamen eingeben,
in C5 den Vornamen

Bei Übereinstimmung könnte sich ja evtl. ein Fenster öffnen, und die zugehörige Kundennummer/n (ab A9) anzeigen ?? oder direkt in die ensprechende Zelle springen ?? Ich weiss nicht genau wie man es anstellen kann mit Mehrfach-Ergebnissen (es kann ja 10 Kunden mit dem Namen Birgit Meier geben)

Kann mir jemand bei der Lösung helfen ???

Gruss - Petra

Answer 1

Hallo,

ich würde dir vorschlagen es mit Autofilter über alle Spalten zu versuchen, da kannst du über alle Kriterien filtern. Ist unter "Daten", "Filter""Autofilter" zu finden

Gruß

Helmut

Answer 2

Hallo,

ja - habe ich auch schon dran gedacht.

Das Problem ist nur, dass diejenige, die mit der Tabelle arbeiten muss, 2 "linke Hände" hat, ich werde ihr wahrscheinlich 10 mal erklären müssen wie man den Filter wieder auf "alle anzeigen" umstellt ... (ist wirklich so) !!

Das bringt mich auf eine Idee: Kann man nicht den Befehl, der hinter dem Autofilter sitzt (bezogen auf Spalte B) per Makro einbauen?? Und über eine Schaltfläche wieder alle Daten anzeigen lassen?? Würde ja vollkommena usreichen.

Gruss - Petra

Answer 3

Hallo Petra,
Code in die Tabelle einfügen, wo gefiltert werden soll.
B4 =Nachname C4 = Vorname
Ist B4 leer wird der Filter zurückgesetzt.

Gruß
fedjo


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Spalte As Range
Application.ScreenUpdating = False
Cells.Rows.EntireRow.Hidden = False
For Each Zelle In Range("B9:B" & Range("B65536").End(xlUp).Row)
If Zelle.Text <> Range("B4").Value Then
Zelle.Rows.EntireRow.Hidden = True
End If
Next
For Each Spalte In Range("C9:C" & Range("C65536").End(xlUp).Row)
If Spalte.Text <> Range("C4").Value Then
Spalte.Rows.EntireRow.Hidden = True
End If
Next
If Range("B4") = "" Then Cells.Rows.EntireRow.Hidden = False
End Sub

Answer 4

Hallo Fedjo,

is ja genial ..... damit kommt auch meine Kollegin klar ;-)))

Super toll - vielen Dank!!


@Helmut: auch Dir Danke für die Anregung - hat mir mal wieder gezeigt wie kompliziert man denken kann, und dass es auch viel einfacher geht.


Viele Grüße - Petra

Answer 5

Hallo,

noch eine Frage zu obrigem Makro:

ist es aufwendig das so zu gestalten, dass die Abfrage auch greift wenn z.B. nach Kleinbuchstaben gesucht wird (also meier statt Meier) oder auch bei Tippfehlern (Boeddeker statt Böddeker)??

LG
Petra

Answer 6

Hallo

Zu 1
nutze Ucase()

Zu 2 einige Tips
Daten in ein Array
Vergleich,Umlaute und dessen Platzhalter ersetzen ,erneuter Vergleich

Answer 7

Hallo Petra,
Code in die Tabelle einfügen.
B4 = Nachname
Groß oder Kleinschreibung spielt keine Rolle.

Gruß
fedjo


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c, firstAddress
Dim strSuch As String, rngBer As Range
Set rngBer = Range("B9:B" & Range("B65536").End(xlUp).Row)
With rngBer
strSuch = Range("B4").Value
If strSuch = "" Then
Cells.Rows.EntireRow.Hidden = False
Exit Sub
End If
Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then
MsgBox "Name nicht vorhanden"
Else
firstAddress = c.Address
Do
c.Activate
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Dim zelle As Range
Dim Spalte As Range
Application.ScreenUpdating = False
Cells.Rows.EntireRow.Hidden = False
For Each zelle In Range("B9:B" & Range("B65536").End(xlUp).Row - 1)
If zelle.Text <> ActiveCell Then
zelle.Rows.EntireRow.Hidden = True
End If
Next
End Sub

Answer 8

Hallo Fedjo,

funktionier super gut ... ;-)

Was mich allerdings irritiet ist, dass bei jeder Suche der letzte
Datensatz mit angezeigt wird.

Stört nicht weiter - wundert mich nur... oder liegt es daran, dass sich (durch Umstrukturierung) einige Felder geändert haben??
In C5 = Nachnahme
ab B10 muss gesucht werden


Hab ich da evtl. was übersehen ???


Der Code sieht geändert so aus:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c, firstAddress
Dim strSuch As String, rngBer As Range

Set rngBer = Range("B10:B" & Range("B65536").End(xlUp).Row)

With rngBer
strSuch = Range("C5").Value

If strSuch = "" Then
Cells.Rows.EntireRow.Hidden = False
Exit Sub
End If

Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then
MsgBox "Name nicht vorhanden"
Else
firstAddress = c.Address
Do
c.Activate
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

Dim zelle As Range
Dim Spalte As Range

Application.ScreenUpdating = False
Cells.Rows.EntireRow.Hidden = False
For Each zelle In Range("B10:B" & Range("B65536").End(xlUp).Row - 1)

If zelle.Text <> ActiveCell Then
zelle.Rows.EntireRow.Hidden = True
End If
Next
End Sub


Gruss - Petra

Answer 9

Hallo Petra,
dann vielleicht so:

For Each zelle In Range("B10:B" & Range("B65536").End(xlUp).Row )

Gruß
fedjo

Answer 10

Hallo Fedjo,

jep ;-)))) ..... genau das wars ......

vielen, vielen Dank ......

(ich wüsste gar nicht mehr was ich ohne dieses tolle Forum machen sollte )


Viele Grüße - Petra