AW: Suchfunktion
22.03.2006 15:56:29
IngGi
Hallo Tuvux,
meinst du sowas?
Sub Finden()
Dim SpOff As Variant
Dim strSuche As String
Dim strSuchText As String
Dim rng As Range
Do
SpOff = InputBox("Wonach möchten sie suchen?" & Chr(10) & Chr(10) & _
"Ersatzteil (0), Hersteller (1) oder Händler (2) ?" & Chr(10) & Chr(10) & _
"Bitte Ziffer in Klammern eingeben!")
If SpOff = "" Then Exit Sub
Loop Until SpOff = "0" Or SpOff = "1" Or SpOff = "2"
Select Case SpOff
Case "0"
strSuchText = "Welches Ersatzteil möchten Sie suchen?"
Case "1"
strSuchText = "Welchen Hersteller möchten Sie suchen?"
Case Else
strSuchText = "Welchen Händler möchten sie suchen?"
End Select
strSuche = InputBox(strSuchText)
Sheets("Tabelle1").Range("D6:F65536").ClearContents
For Each rng In Sheets("Tabelle2").Range(Cells(3, 1 + CByte(SpOff)), _
Cells(Sheets("Tabelle2").Range("A65536").End(xlUp).Row, 1 + CByte(SpOff)))
If rng = strSuche Then
Range(rng.Offset(0, -(CByte(SpOff))), rng.Offset(0, -(CByte(SpOff)) + 2)).Copy
Sheets("Tabelle1").Range("D65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If
Next 'rng
End Sub
Gruß Ingolf