Re: und noch eine Suchfunktion!!
22.12.2002 23:53:29
Maik
Hallo!!
Mir war ein Freund bei der Funktion behilflich..
Ist zwar nicht die beste.. aber sie reicht allemal..
Ich stell mal den Code hier rein, für den Fall, das ihn irgendwann mal jemand brauch.. Leider kann man nur nach einem Verein suchen (entweder Heim oder Gast).
Ist ist aber kein vorzeigecode.. also obacht!! :-)
Private Sub SubtnSuchen_Click()
Dim zeile As Integer
Dim i As Integer
Dim gast_t As String
Dim x As Integer
Dim cb As String
Dim s As String
Dim sp_min As Integer
Dim sp_max As Integer
Dim merker As Integer
Dim sp_temp As Integer
Dim datv As String
Dim datb As String
Dim d_temp As String
Dim text As String
Dim datum As Date
Dim j_temp As String
Dim j_min As Integer
Dim j_max As Integer
Dim j As Integer
Dim m_min As Integer
Dim m_max As Integer
merker = 0
If Suchen.cbgast.text <> "" Then
cb = Suchen.cbgast.text
s = "D"
merker = 1
End If
If Suchen.cbheim.text <> "" Then
cb = Suchen.cbheim.text
s = "c"
merker = 1
End If
If (Suchen.cbheim.text <> "") And (Suchen.cbgast.text <> "") Then
MsgBox ("Bitte nur ein Feld ausfüllen!")
Unload Suchen
Suchen.Show
merker = 0
End If
If Suchen.tbdatv <> "" And Suchen.tbdatb <> "" Then
If (Len(Suchen.tbdatv) <> 10) Or (Len(Suchen.tbdatb) <> 10) Then
MsgBox ("bitte Format tt.mm.jjjj einhalten")
Unload Suchen
End If
merker = 3
datv = Suchen.tbdatv
datb = Suchen.tbdatb
End If
'Spieltagsuche Anfang
If Suchen.tbSpieltagvon <> "" And Suchen.tbspieltagbis <> "" Then
sp_min = Suchen.tbSpieltagvon
sp_max = Suchen.tbspieltagbis
merker = 2
End If
'Kopfzeile kopieren
Tabelle2.Activate
i = 1
While Range("a" & i) = ""
i = i + 1
Wend
Rows(i).Select
Selection.Copy
Tabelle4.Activate
Range("A" & i).Select
Tabelle4.Paste
'hier beginnt Hauptschleife Gast suchen
Tabelle2.Activate
zeile = i + 1
If merker = 1 Then
While Range(s & zeile).Value <> ""
gast_t = Range(s & zeile).Value
If gast_t = cb Then
Rows(zeile).Select
Selection.Copy
Tabelle4.Activate
x = i
While Range("a" & x).Value <> ""
x = x + 1
Wend
Range("A" & x).Select
Tabelle4.Paste
Tabelle2.Activate
End If
zeile = zeile + 1
Wend
End If
'Jetzt fängt "Spieltagsuchen" an
If merker = 2 Then
While Range("B" & zeile).Value <> ""
sp_temp = Range("B" & zeile).Value
If (sp_temp >= sp_min) And (sp_temp <= sp_max) Then
Rows(zeile).Select
Selection.Copy
Tabelle4.Activate
x = i
While Range("a" & x).Value <> ""
x = x + 1
Wend
Range("A" & x).Select
Tabelle4.Paste
Tabelle2.Activate
End If
zeile = zeile + 1
Wend
End If
'Datum Suchfunktion
If merker = 3 Then
While Range("a" & zeile).Value <> ""
d_temp = Range("a" & zeile).Value
j = Val(Right$(d_temp, 4))
j_min = Val(Right$(datv, 4))
j_max = Val(Right$(datb, 4))
m = Val(Right$(Left$(d_temp, 5), 2))
m_min = Val(Right$(Left$(datv, 5), 2))
m_max = Val(Right$(Left$(datb, 5), 2))
t = Val(Left$(d_temp, 2))
t_min = Val(Left$(datv, 2))
t_max = Val(Left$(datb, 2))
marker = 0
marker2 = 0
marker3 = 0
marker4 = 0
marker5 = 0
If (j > j_min) And (j < j_max) Then
marker = 1
End If
If j = j_min Then marker2 = 1
If j = j_max Then marker3 = 1
If marker2 = 1 And m > m_min Then marker = 1
If marker2 = 1 And m = m_min Then marker4 = 1
If marker4 = 1 And t >= t_min Then marker = 1
If marker3 = 1 And m < m_max Then marker = 1
If marker3 = 1 And m = m_max Then marker5 = 1
If marker5 = 1 And t <= t_max Then marker = 1
If marker = 1 Then
Rows(zeile).Select
Selection.Copy
Tabelle4.Activate
x = i
While Range("a" & x).Value <> ""
x = x + 1
Wend
Range("A" & x).Select
Tabelle4.Paste
Tabelle2.Activate
End If
zeile = zeile + 1
Wend
End If
End Sub
Private Sub SuchebtnAbbrechen_Click()
Suchen.Hide
End Sub