AW: Case - was mache ich falsch?
MichiM
Hier mal alles, was ich bekommen habe.
'Hallo michi,
'kurze Erklärung des Makros:
Sub SuchDatenUndKopiere()
Dim Suchname As String
Dim Suchvorname As String
Dim Suchstrasse As String
Dim Suchplz As String
Dim Suchort As String
Dim Auswahlsumme As Integer
'Löschen der Inhalte aus dem Blatt Ergebnis
Worksheets("Ergebnis").Cells.ClearContents
'Initialisieren der Suchkriterien
Suchname = ""
Suchvorname = ""
Suchstrasse = ""
Suchplz = ""
Suchort = ""
'Wenn Suchkriterium Name auf Blatt SUCHE gefüllt ist, ins Suchkriterium übertragen
If Not (Worksheets("Suche").Cells(2, 1).Value) = "" Then
Suchname = Worksheets("Suche").Cells(2, 1).Value
'Summe bilden, um festzustellen, was an Suchkriterien vorgegeben ist
Auswahlsumme = Auswahlsumme + 1
End If
If Not (Worksheets("Suche").Cells(2, 2).Value) = "" Then
Suchvorname = Worksheets("Suche").Cells(2, 2).Value
Auswahlsumme = Auswahlsumme + 2
End If
If Not (Worksheets("Suche").Cells(2, 3).Value) = "" Then
Suchstrasse = Worksheets("Suche").Cells(2, 3).Value
Auswahlsumme = Auswahlsumme + 4
End If
If Not (Worksheets("Suche").Cells(2, 4).Value) = "" Then
Suchplz = Worksheets("Suche").Cells(2, 4).Value
Auswahlsumme = Auswahlsumme + 8
End If
If Not (Worksheets("Suche").Cells(2, 5).Value) = "" Then
Suchort = Worksheets("Suche").Cells(2, 5).Value
Auswahlsumme = Auswahlsumme + 16
End If
'Anhand von Auswahlsumme wird erkannt, welche Suchkriterien gefüllt sind
'Beispiel: Wenn Suchkriterien Name, Vorname und Ort gefüllt sind, müßte
'dieAuswahlsumme auf 19 = 1 für Name
' + 2 für Vorname
+ 16 für Ort stehen
Select Case Auswahlsumme
Case 1
Suche1 (Suchname)
' Case 2
' Suche2
'... je nach Summe (die ist eindeutig) die Felder abgleichen
Case 19
Suche19 (Suchname, Suchvorname, Suchort)
End Select
End Sub
Sub Suche1(Name As String)
Dim I As Integer
'Nur Name als Suchkriterium
For I = 2 To Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
If Name = Worksheets("Daten").Cells(I, 1).Value Then
Kopieren (I)
End If
Next
End Sub
Sub Suche19(Name As String, Vorname As String, Ort As String)
Dim I As Integer
'Suchkriterien = Name, Vorname, Ort
'Schleife bis zur letzten Zeile in Blatt DATEN
For I = 2 To Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
'Abgleichen der Zeileninhalte mit Suchkriterien
If Name = Worksheets("Daten").Cells(I, 1).Value and _
Vorname = Worksheets("Daten").Cells(I, 2).Value and
Ort = Worksheets("Daten").Cells(I, 6).Value and Then
'Aufruf der
Sub fürs Kopieren der entsprechenden Zeile
Kopieren (I)
End If
Next
End Sub
Sub Kopieren(Zeile As Long)
'Übnertragen der Werte aus DATEN in ERGEBNIS
Dim NextRow As Long
NextRow = Worksheets("Ergebnis").Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Ergebnis").Cells(NextRow, 1) = _
Worksheets("Daten").Cells(Zeile, 1)
Worksheets("Ergebnis").Cells(NextRow, 2) = _
Worksheets("Daten").Cells(Zeile, 2)
Worksheets("Ergebnis").Cells(NextRow, 3) = _
Worksheets("Daten").Cells(Zeile, 4)
Worksheets("Ergebnis").Cells(NextRow, 4) = _
Worksheets("Daten").Cells(Zeile, 5)
Worksheets("Ergebnis").Cells(NextRow, 5) = _
Worksheets("Daten").Cells(Zeile, 6)
End
Sub
Danke
Michi