Listbox mit Daten aus 3 Tabellen füttern
k
kurze Frage ob es überhaupt möglich wäre und wenn ja wie ?!
Folgendes Problem:
Ich habe 4 verschieden Tabellen in denen Daten per jeweiliger Userform eingeben werden. Klappt alles super. Nun möchte ich gern die Kundendaten aus allen 4 Tabellen in einer Listbox anzeigen lassen (alle Tabellen haben den gleichen Aufbau im Bereich Kundendaten und erst danach kommen unterschiedliche Informationen dazu), damit z.B. Kundendaten aus der Userform 1 (Tabelle1) auch in Userform 2 (Tabelle) übernommen werden können.
Dachte da an eine Userform mit Suchfunktion über alle 4 Tabellenblätter und eine Listbox, die alle Einträge anzeigt (ohne Dopplungen!!!!) und ein Button - Datensatz übernehmen. D.h. wenn ein Datensatz in der Listbox markiert wurde - wird dieser in einer der anderen Userform eingelesen und kann darüber weiter bearbeitet und gespeichert werden.
Hoffe es ist grob nachvollziehbar wo ich hin will.... brauche aber Unterstützung!
Hatte schon mal Beitrag zu "doppelten" geschrieben, aber der Code funktioniert bei mir nicht ?!
https://www.herber.de/forum/archiv/1088to1092/t1089694.htm#1089694
mehrere Tabellenblätter durchsuchen hatte ich folgenden Code probiert und (bis auf doppelte) scheint er auch zu funktionieren....mein Problem ist noch den ausgewählten Datensatz in der gewünschten Userform einzulesen sowie doppelte Einträge zu vermeiden.
Option Explicit
Dim wks As Worksheet
Dim wkb1, wkb2 As Workbook
Dim XBlatt, wks2 As Worksheet
Dim XZeile As Long
Dim Suchart As String
Dim xOpt As Integer
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UF5_ATB_Initialize()
Suchart = xlPart
xOpt = 1
End Sub
Private Sub CommandButton3_Click()
Dim xSuche, xAdresse, xErste, SO As String
Dim Y As Boolean
Dim arr() As Variant
Dim rng As Range
Dim iCounter, iRowU As Integer
LB1.Clear
xSuche = TB1.Value
Suchart = xlWhole
If xSuche = "" Then
MsgBox "Bitte erst einen Suchbegriff eingeben!", vbExclamation, "Achtung!"
Exit Sub
End If
If OB1.Value = True Then
SO = "ATE"
Else
If OB2.Value = True Then
SO = "ZKE"
Else
If OB3.Value = True Then
SO = "STE"
End If
End If
End If
For iCounter = 1 To ThisWorkbook.Sheets.Count
If OB4.Value = True Or Worksheets(iCounter).Name = SO Then 'OB4 = Optionsbutton - gesamte _
Datei durchsuchen (müssten och angepasst werden auf Tabelle 1-4 durchsuchen)
Set rng = Worksheets(iCounter).Cells.Find _
(xSuche, lookat:=Suchart, LookIn:=xlValues)
If Not rng Is Nothing Then
With Worksheets(iCounter)
xErste = rng.Address(False, False)
Y = True
Do Until xAdresse = xErste
ReDim Preserve arr(0 To 15, 0 To iRowU)
arr(0, iRowU) = .Name
arr(1, iRowU) = rng.Address(False, False)
arr(2, iRowU) = .Cells(rng.Row, 1)
arr(3, iRowU) = .Cells(rng.Row, 2)
arr(4, iRowU) = .Cells(rng.Row, 3)
arr(5, iRowU) = .Cells(rng.Row, 4)
arr(6, iRowU) = .Cells(rng.Row, 5)
arr(7, iRowU) = .Cells(rng.Row, 6)
arr(8, iRowU) = .Cells(rng.Row, 7)
arr(9, iRowU) = .Cells(rng.Row, 8)
arr(10, iRowU) = .Cells(rng.Row, 9)
arr(11, iRowU) = .Cells(rng.Row, 10)
arr(12, iRowU) = .Cells(rng.Row, 11)
arr(13, iRowU) = .Cells(rng.Row, 12)
arr(14, iRowU) = .Cells(rng.Row, 13)
arr(15, iRowU) = .Cells(rng.Row, 14)
iRowU = iRowU + 1
Set rng = .Cells.FindNext(after:=rng)
xAdresse = rng.Address(False, False)
Loop
xAdresse = ""
xErste = ""
End With
End If
End If
Next iCounter
If Y = False Then
MsgBox "Der Suchbegriff wurde nicht gefunden!"
Else
LB1.Column = arr
End If
End Sub
Hoffe mir kann geholfen werden, oder jemand hat eine bessere Idee - wie ich es realiseren kann ?!
Dachte auch schon an eine Tabelle im Hintergrund, wo die Kundendaten aus allen Tabellen 1-4 reinkopiert werden (beim auslösen der Suche, also Temporär) - Ohne Dopplungen !!! - und dann die Userform-Suche (UF5_ATB) darauf suchen lassen.
Denke fast, das es einfacher wäre...nur dass eben hier die "doppelten" auch rausgeschmissen werden müssten.
(Hinweis: Kundendaten sind ca. 1.000-1.500 verschiedene und ca. 20 Spalten an Infos zu jedem Kunden)
OK, doch wieder länger geworden. Danke für Eure Zeit (allein schon fürs Lesen!)
Gruß
Kay