da die Recherche zur Zeit nicht so richtig geht, siehe auch Technik Forum lade Dir folgende Datei runter
http://www.excel-cd.de/downloads/xlWebFinder.zip
damit kannst Du dir 100 Beiträge anzeigen lasssen
Der Code wurde getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.
Microsoft MVP für Excel
'Option Explicit
'Private Sub Workbook_Open()
'UserForm1.Show
'End Sub
DANKE
IVAN
ich benutze grundsätzlich Option Explicit. Diese Zeile bedeutet das jede Variable vor ihrer ersten Verwendung definiert werden muß.
Starte Deinen Code doch mal im Einzelschritt.
Gruß Hajo
MEIN CODE
Private Sub Userform_Activate()
Suche.Caption = "Suche"
End Sub
Private Sub Suche_Click()
On Error Resume Next
If Err.Number <> 0 Then
MsgBox "Kein Eintrag vorhanden!", vbCritical, "Schreiben Sie was rein"
End If
Dim s As String
Dim Found As Range
Dim FirstAddress As String
Dim i As Integer ' Zeile
i = 0
If ComboBox1.Text = "" Then
MsgBox "Kein Eintrag vorhanden!", vbCritical, "Was soll ich den suchen?"
Suche.SetFocus
Else
End If
Eingabe = ComboBox1.Text
If Eingabe = "" Then Exit Sub
ListBox1.Clear
ListBox2.Clear
With ActiveSheet
Set Found = .Cells.Find(Eingabe, LookAt:=xlPart)
If Not Found Is Nothing Then
FirstAddress = Found.Address
ListBox1.ColumnCount = 1
ListBox1.AddItem Found
ListBox1.List(i, 1) = Cells(Found.Row, 13)
ListBox2.AddItem Found.Row
i = i + 1
Do
Found.Activate
Set Found = Cells.FindNext(After:=ActiveCell)
On Error Resume Next
If Found.Address = FirstAddress Then Exit Do
ListBox1.AddItem Found
ListBox1.List(i, 1) = Cells(Found.Row, 13)
ListBox2.AddItem Found.Row
i = i + 1
Loop
End If
End With
Suche.Caption = "Neue Suche"
End Sub
'Hier erfolgt die Ausgabe des gesuchten
'in einer combobox per Auswahl in der ListBox
Private Sub ListBox1_Click()
If ListBox1.Value <> "" Then
On Error Resume Next
ListBox2.ListIndex = ListBox1.ListIndex
txtNachname = Cells(ListBox2.Value, 1)
txtVorname = Cells(ListBox2.Value, 2)
txtPlz = Cells(ListBox2.Value, 3)
txtOrt = Cells(ListBox2.Value, 4)
txtAdresse = Cells(ListBox2.Value, 5)
txtTelefon = Cells(ListBox2.Value, 6)
txtHandy = Cells(ListBox2.Value, 7)
txtFax = Cells(ListBox2.Value, 8)
txtEmail = Cells(ListBox2.Value, 9)
txtKennung = Cells(ListBox2.Value, 10)
txtAnmerkung = Cells(ListBox2.Value, 11)
'txtGesamtPreis = Cells(ListBox2.Value, 20) & " "
End If
End Sub
DANKE
IVAN
gib es die Steuerelemente
"Suche"; "ComboBox1"
Gruß Hajo