Office: Filterung mit Suchmaske in VBA

Hallo Zusammen,

ich bin noch VBA-Neuling und bin gerade am Üben. Derzeit möchte ich eine Filterung erstellen über eine Bundesliga-Datenbank, die über 1800 Zeilen geht. Hierzu soll nach einem Klick auf einen Button in Excel eine Suchmaske erscheinen, in der verschiedene Filteroptionen ausgewählt werden können. Dabei soll die Liga, das Land, der Verein, die Trikotnummer, Tore, Vorlagen und der Name gefiltert werden können. Beim Namen sollen die Buchstaben einzeln abgeprüft werden und in einer beliebigen Reihenfolge um Rechtschreibfehlern vorzubeugen oder als Spielerei (z.B. in welchen Spielernamen steckt in einer Reihenfolge das Wort "Baum"). Die Ausgabe der Spielername soll in einer Box unten erfolgen (Name: "lbergebnis"), nachdem der User auf den "Suchen"-Button geklickt hat (cmdmsuchen).

Das mit dem Namen allein hat bisher gut funktioniert. Sobald ich aber die weiteren Bedingungen daran binde kommt gar kein Ergebnis mehr, bzw. seltsamerweise ein einziger Spieler, der keine besonderen Eigenschaften besitzt.

Die Länder, Vereine und Liga soll als Auswahlbox erscheinen. Das funktioniert auch. Ich habe es auch geschafft, dass nach Auswahl der Liga nur noch die jeweiligen Vereine angezeigt werden. Aber irgendwo ist hier der Wurm drin. Hat jemand eine Idee?

Vielen Dank und viele Grüße

Nico


Option Explicit

Private Sub cmbLiga_AfterUpdate()
With ThisWorkbook.Sheets("bundesliga_Spieler")
Dim lngRow As Long

lngRow = 2
cmbVerein.Clear
Do While .Cells(lngRow, 13) ""
If .Cells(lngRow, 14) = CLng(cmbLiga) Then Call AddSortedToBox(cmbVerein, .Cells(lngRow, 13))
lngRow = lngRow + 1
Loop
End With
End Sub

Private Sub cmdsuchen_Click()

With ThisWorkbook.Sheets("bundesliga_Spieler")

Dim strSpielername As String
Dim lngSpielerBuchstabe As Long
Dim booTreffer As Boolean
Dim lngSuchBuchstabe As Long
Dim lngRow As Long

lngRow = 2

Do While .Cells(lngRow, 4) ""
strSpielername = .Cells(lngRow, 4)

For lngSuchBuchstabe = 1 To Len(txtsuche)
booTreffer = False

For lngSpielerBuchstabe = 1 To Len(strSpielername)
If Mid(strSpielername, lngSpielerBuchstabe, 1) = Mid(txtsuche, lngSuchBuchstabe, 1) Then booTreffer = True
Next lngSpielerBuchstabe

If booTreffer = False Then Exit For
Next lngSuchBuchstabe

If booTreffer = True Then
If .Cells(lngRow, 5) = cmbLand And _
.Cells(lngRow, 14) = cmbLiga And _
.Cells(lngRow, 13) = cmbVerein Then
Call AddSortedToBox(lbergebnis, strSpielername)
End If
End If

lngRow = lngRow + 1

Loop
End With
End Sub

Private Sub UserForm_Activate()
Dim lngRow As Long
Dim strSpielername As String

cmbLand.Clear

With ThisWorkbook.Sheets("Bundesliga_Spieler")

lngRow = 2

Do While .Cells(lngRow, 5) ""
Call AddSortedToBox(cmbLand, .Cells(lngRow, 5))
lngRow = lngRow + 1
Loop
End With

cmbVerein.Clear

With ThisWorkbook.Sheets("bundesliga_Spieler")

lngRow = 2

Do While .Cells(lngRow, 13) ""
Call AddSortedToBox(cmbVerein, .Cells(lngRow, 13))
lngRow = lngRow + 1
Loop
End With

cmbLiga.Clear

With ThisWorkbook.Sheets("bundesliga_Spieler")

lngRow = 2

Do While .Cells(lngRow, 14) ""
Call AddSortedToBox(cmbLiga, .Cells(lngRow, 14))
lngRow = lngRow + 1
Loop
End With

With ThisWorkbook.Sheets("bundesliga_Spieler")

lngRow = 2

Do While .Cells(lngRow, 3) ""
If cbt09 = True And _
.Cells(lngRow, 3) > 0 And _
.Cells(lngRow, 3) < 10 Or cbt1019 And _
.Cells(lngRow, 3) > 9 And _
.Cells(lngRow, 3) < 20 Or cbt2029 And _
.Cells(lngRow, 3) > 19 And _
.Cells(lngRow, 3) < 30 Or cbt3039 And _
.Cells(lngRow, 3) > 29 And _
.Cells(lngRow, 3) < 40 Or cbt4049 And _
.Cells(lngRow, 3) > 39 And _
.Cells(lngRow, 3) < 50 Or cbt49 And _
.Cells(lngRow, 3) > 49 Then
Call AddSortedToBox(lbergebnis, strSpielername)
End If
lngRow = lngRow + 1
Loop
End With
End Sub

:)

 

Hola,

zur Info:

http://www.herber.de/forum/messages/1515270.html

http://vba.itatservice.de/forum/View...chmaske_in_VBA

Gruß,
steve1da