suchen-finden-kopieren

Hallo EXCEL-Fachleute!
Seit eineigen Tagen versuche ich ein Makro >> suchen finden zeigen auswählen - kopieren Es geht um eine Datei, bestehend aus 2 Tabellen. In der Tabelle 2 befinden sich folgende Informationen:
Spalte A = KundenNummer
Spalte B = Name und Vorname
Spalte D = Straße
Spalte G = Ort
Ich möchte folgendes erreichen:
Nach einem Klick auf ein Button erscheint eine Dialogbox (InputBox): Wonach soll gesucht werden?.
Nach Eingabe einer Buchstabenkombination z. B. sch in die Dialogbox und nach einer Bestätigung mit OK bzw. Suchen, werden in einem DropDownListenfeld alle die Datensätze aus der Tabelle 2 untereinander zur Auswahl gestellt, die in den Spalten B bis G den Suchbegrif sch beinhalten. Angezeigt werden aber nicht ganze Datensätze sondern nur Inhalte von Zellen B und G z. B.:
Andreas Schmitt München
Paul Schmidt Mainz
Björn Koschwitz Berlin
Anita Braun Braunschweig.
Einer der Kunden wird mit DropDown ausgewählt. Sofort danach soll seine KundenNummer aus der Spalte A in der Tabelle2 in die Zelle D15 in der Tabelle1 eingetragen (kopiert) werden. Die Dialogbox verschwindet danach.
Wenn nichts gefunden wird, kommt eine Info Nichts gefunden und die DialogBox verschwindet nach Bestätigung mit OK.
Mit der gefundenen Kundennummer werden dann weitere Berechnungen durchgeführt (in der Tabelle1). Alles sollte ich also bei aktiver Tabelle1 abspielen.
Kann mir jemand helfen? Ich habe schon mit allen möglichen Formeln (Wenn, Index, Vergleich, Verweis usw.) probiert. Ich habe jedoch nicht das erreicht, was ich haben möchte.
Vielen, vielen Dank im Voraus
Skater

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sepp!
Sei bitte nicht sauer. Ich weiß, ich bin lästig. Aber ich quäle mich schon seit 3 Tagen und kann nicht herausfinden warum die Suchprozedur mit der Übernameprozedur nicht mitspielen will.
Ich wäre für jeden Hinweis sehr verbunden.
Hier noch einmal der gesamte Code:


Private Sub cmdCancel_Click()
'Schliessen
Unload Me
End Sub


Private Sub cmdOK_Click()
'Auswahl übernehmen
With ListBox1
If .ListIndex > -1 Then
If Left(.Text, 3) <> "---" Then
Sheets("Angebot").Range("B11") = Sheets("Kunden").Cells(.List(.ListIndex, 2), 1)
Sheets("Angebot").Range("B13") = Sheets("Kunden").Cells(.List(.ListIndex, 2), 2)
Sheets("Angebot").Range("B15") = Sheets("Kunden").Cells(.List(.ListIndex, 2), 4)
Sheets("Angebot").Range("B17") = Sheets("Kunden").Cells(.List(.ListIndex, 2), 6) & _
", " & Sheets("Kunden").Cells(.List(.ListIndex, 2), 7)
Unload Me
Else
Exit Sub
End If
Else
MsgBox "Bitte treffen Sie eine Auswahl!", 48, "Hinweis"
End If
End With
End Sub


Private Sub cmdSearch_Click()
'Suchen
Dim rngSearch As Range
Dim strFirst As String
If txtSearch = "" Then Exit Sub
ListBox1.Clear
With Sheets("Kunden")
Set rngSearch = .Range("B:G").Find(What:=txtSearch, LookAt:=xlPart, after:=.Range("B65536"))
If Not rngSearch Is Nothing Then
strFirst = rngSearch.Address
Do
ListBox1.AddItem .Cells(rngSearch.Row, 2) '"B"
ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(rngSearch.Row, 4) '"D"
ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(rngSearch.Row, 7) '"G"
Set rngSearch = .Range("B:G").FindNext(rngSearch)
Loop While Not rngSearch Is Nothing And strFirst <> rngSearch.Address
Else
ListBox1.AddItem "--- Keine Fundstellen! ---"
End If
End With
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
cmdOK_Click 'Bei Dopelklick auf Listboxeintrag wird dieser übernommen!
End Sub


Private Sub txtSearch_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then cmdSearch_Click   'Mit der ENTER-taste wird die Suche gestartet!
End Sub


Private Sub UserForm_Click()
End Sub

Private Sub cmdOK_Click() 'Auswahl übernehmen With ListBox1 If .ListIndex > -1 Then If Left(.Text, 3) <> "---" Then Sheets("Angebot").Range("B11") = Sheets("Kunden").Cells(.List(.ListIndex, 2), 1) Sheets("Angebot").Range("B13") = Sheets("Kunden").Cells(.List(.ListIndex, 2), 2) Sheets("Angebot").Range("B15") = Sheets("Kunden").Cells(.List(.ListIndex, 2), 4) Sheets("Angebot").Range("B17") = Sheets("Kunden").Cells(.List(.ListIndex, 2), 6) & _ ", " & Sheets("Kunden").Cells(.List(.ListIndex, 2), 7) Unload Me Else Exit Sub End If Else MsgBox "Bitte treffen Sie eine Auswahl!", 48, "Hinweis" End If End With End Sub

Private Sub cmdSearch_Click() 'Suchen Dim rngSearch As Range Dim strFirst As String If txtSearch = "" Then Exit Sub ListBox1.Clear With Sheets("Kunden") Set rngSearch = .Range("B:G").Find(What:=txtSearch, LookAt:=xlPart, after:=.Range("B65536")) If Not rngSearch Is Nothing Then strFirst = rngSearch.Address Do ListBox1.AddItem .Cells(rngSearch.Row, 2) '"B" ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(rngSearch.Row, 4) '"D" ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(rngSearch.Row, 7) '"G" Set rngSearch = .Range("B:G").FindNext(rngSearch) Loop While Not rngSearch Is Nothing And strFirst <> rngSearch.Address Else ListBox1.AddItem "--- Keine Fundstellen! ---" End If End With End Sub

Private Sub cmdOK_Click() 'Auswahl übernehmen With ListBox1 If .ListIndex > -1 Then If Left(.Text, 3) <> "---" Then Sheets("Angebot").Range("B11") = .List(.ListIndex, 0) Sheets("Angebot").Range("B13") = .List(.ListIndex, 1) Sheets("Angebot").Range("B15") = .List(.ListIndex, 3) Sheets("Angebot").Range("B17") = .List(.ListIndex, 5) & " " & .List(.ListIndex, 6) Unload Me Else Exit Sub End If Else MsgBox "Bitte treffen Sie eine Auswahl!", 48, "Hinweis" End If End With End Sub

Private Sub cmdSearch_Click() 'Suchen Dim rng As Range Dim wks As Worksheet Dim sFirst As String, sFind As String, strWidth As String Dim iCnt As Integer, n As Integer, lastCol As Integer Set wks = Sheets("Kunden") lastCol = wks.Range("IV3").End(xlToLeft).Column With ListBox1 .Clear .ColumnCount = lastCol + 1 For iCnt = 1 To .ColumnCount - 1 strWidth = strWidth & "100;" Next strWidth = strWidth & "0" .ColumnWidths = strWidth sFind = txtSearch Set rng = wks.Range("A4:IV65536").Find(What:=sFind, LookIn:=xlValues, _ LookAt:=xlPart, after:=wks.Range("IV65536")) If Not rng Is Nothing Then sFirst = rng.Address Do .AddItem wks.Cells(rng.Row, 1) For iCnt = 2 To lastCol + 1 .List(n, iCnt - 1) = wks.Cells(rng.Row, iCnt) Next .List(n, .ColumnCount - 1) = rng.Row n = n + 1 Set rng = wks.Range("A4:IV65536").FindNext(rng) Loop While rng.Address <> sFirst Else ListBox1.AddItem "--- Keine Fundstellen! ---" End If End With End Sub

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

suchen-finden-kopieren

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread