Suchergebnis durch Doppelklick öffnen
21.06.2013 21:56:23
Mario
ich versuche eine Kundendatenbank in Excell komplett über die Userform laufen zu lassen. In meinem Suchformular kann ich nach Kundennummer, oder Name suchen. Das Ergebnis wird mir in einer Listbox ausgegeben. Durch doppelklicken des gewünschten Kunden, soll sich eine neue Userform öffnen und dort werden dann alle Daten des Kunden in Textboxen ausgegeben.
Die Suche und Ausgabe in der Listenbox klappt wunderbar, nur wenn ich versuche durch Dppelklick auf den Kunden die Daten in die neue Usreform zu übergeben, dann scheitert es bei mir. Ich erhalte immer den gleichen Kunden.
Wie schaffe ich es, dass ich den gesuchten Kunden auch übergeben bekomme?
Vielen Dank für die Hilfe.
Suche und Ausgabe:
Private Sub cmdSuche_Click()
Dim wks As Worksheet
Dim rZelle As Range
Dim firstmatch
Set wks = ThisWorkbook.Worksheets("Kundenliste")
' befindet sich ein Suchbegriff in einer der beiden Textfelder, wenn ja, ist auch nur ein Feld _
ausgefüllt
If txtACSuche.Value "" Xor txtNameSuche.Value "" Then
' Wenn ein Wert in Name, suche in Spalte 4
If txtNameSuche.Value "" Then
With wks.Columns(4)
'Suche beginnt
Set rZelle = .find _
(What:=txtNameSuche.Value, _
LookAt:=xlPart, _
LookIn:=xlValues)
'wenn ein Ergebnis vorliegt, speichere die Adresse des ersten Fundes und füge in _
der Listbox die Zeilendaten ein
If Not rZelle Is Nothing Then
firstmatch = rZelle.Address
Do
ListSuche.AddItem
ListSuche.List(ListSuche.ListCount - 1, 0) = wks.Cells(rZelle.row, 2).Value
ListSuche.List(ListSuche.ListCount - 1, 1) = wks.Cells(rZelle.row, 4).Value
ListSuche.List(ListSuche.ListCount - 1, 2) = wks.Cells(rZelle.row, 5).Value
ListSuche.List(ListSuche.ListCount - 1, 3) = wks.Cells(rZelle.row, 10).Value
' Suche fortsetzen
Set rZelle = .FindNext(rZelle)
' mache dies solange ein Ergebnis gefunden wurde und Ergebnis nicht das erste _
gefundene ist
Loop While Not rZelle Is Nothing And firstmatch rZelle.Address
Else
MsgBox "Der Name """ & txtNameSuche.Value & _
""" existiert nicht."
End If
End With
Else
' Wenn ein Wert in AC, suche in Spalte 2
With wks.Columns(2)
'Suche beginnt nach exaktem Wert
Set rZelle = .find _
(What:=txtACSuche.Value, _
LookAt:=xlWhole, _
LookIn:=xlValues, _
SearchOrder:=xlByColumns)
' wenn Wert gefunden, in Listbox eintragen
If Not rZelle Is Nothing Then
ListSuche.AddItem wks.Cells(rZelle.row, 2).Value
ListSuche.List(ListSuche.ListCount - 1, 1) = wks.Cells(rZelle.row, 4).Value
ListSuche.List(ListSuche.ListCount - 1, 2) = wks.Cells(rZelle.row, 5).Value
ListSuche.List(ListSuche.ListCount - 1, 3) = wks.Cells(rZelle.row, 10).Value
Else
MsgBox "Die Kundennummer """ & txtACSuche.Value & _
""" existiert nicht."
End If
End With
End If
Else
MsgBox "Bitte geben Sie (nur) einen Suchbegriff ein."
End If
End Sub
Private Sub ListSuche_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim x
' +2, da meine Tabelle in Zeile 2 anfängt - hier haperst es aber auch, da ich nicht die _
richtige Zeile erhalte
x = ListSuche.ListIndex + 2
With frmKundendatei
.txtEingangsdatum_datei = Worksheets("Kundenliste").Cells(x, 1)
.txtKundennummer_datei = Worksheets("Kundenliste").Cells(x, 2)
.txtAuftragsnummer_datei = Worksheets("Kundenliste").Cells(x, 3)
.txtName_datei = Worksheets("Kundenliste").Cells(x, 4)
.txtVorname_datei = Worksheets("Kundenliste").Cells(x, 5)
.txtStrasse_datei = Worksheets("Kundenliste").Cells(x, 6)
.txtPLZ_datei = Worksheets("Kundenliste)").Cells(x, 7)
.txtOrt_datei = Worksheets("Kundenliste").Cells(x, 8)
.txtWiedervorlage_datei = Worksheets("Kundenliste").Cells(x, 9)
.txtStatus_datei = Worksheets("Kundenliste").Cells(x, 10)
.txtUser_datei = Worksheets("Kundenliste").Cells(x, 11)
.txtSachverhalt_datei = Worksheets("Kundenliste)").Cells(x, 12)
.txtTelefon_datei = Worksheets("Kundenliste").Cells(x, 13)
.txtMobil_datei = Worksheets("Kundenliste").Cells(x, 14)
.txtEMail_datei = Worksheets("Kundenliste").Cells(x, 15)
End With
frmKundendatei.Show
End Sub