ListBox Mehrspaltig mit Mehreren Sheets befüllen

[toto18]

Schön Guten Tag Liebe Helfer,

ich bin Neu hier im Forum und so ziemlich noch Grün hinter den Ohren im bereich VBA. Ich weiß den Satz Ließt Ihr Sicherlich nicht zum Ersten mal.
Seit Tagen zerbreche ich mir den Kopf  ,die Sicherlich für euch eine Kleinigkeit darstellen wird..
Also Zu meinem anliegen: Ich habe mir eine Mehrspaltige Listbox1 erstellt welche über ein Text Button für eine Freitext Angabe in meiner Tabellen Sucht. Und die End sprechenden Daten ausgibt. Für das Auslesen einer Tabelle habe ich es wunderbar hinbekommen... Aber wie muss ich den Code Programmieren das er gleichzeitig in allen Tabellen Sucht?

meine Worksheets Sind: "Gemüse";"Fleisch";"Trockenware"; "Molkerei";"Fisch" und "NonFood" also 6 Tabellen blätter die alle gleich auf gebaut sind mit 8 Spalten von A3 bis H3
Artikel /Einheit/Lieferant/Art. Nr.:/ Gebindepreis/ Putzverlust/ Garverlust/ Beschreibung

Mein Code :


Private Sub TextBox1_Change()
Dim LRow As Long, i As Long
Dim wks1 As Worksheet
Set wks1 = Worksheets("Gemüse")
LRow = wks1.Cells(Rows.Count, 1).End(xlUp).Row
With Me
ListBox1.Clear
For i = 3 To LRow
If UCase(Left(wks1.Cells(i, 1).Text, Len(TextBox1.Text))) = UCase(TextBox1.Text) Then
With .ListBox1
.ColumnCount = 8
.ColumnWidths = "7cm;3cm;3cm;3cm;3cm"
.AddItem wks1.Cells(i, 1)
.List(.ListCount - 1, 1) = wks1.Cells(i, 2)
.List(.ListCount - 1, 2) = wks1.Cells(i, 3)
.List(.ListCount - 1, 3) = wks1.Cells(i, 4).Text
.List(.ListCount - 1, 4) = wks1.Cells(i, 5).Text
.List(.ListCount - 1, 5) = wks1.Cells(i, 6)
.List(.ListCount - 1, 6) = wks1.Cells(i, 7)
.List(.ListCount - 1, 7) = wks1.Cells(i, 8)

End With
End If
Next i
End With

End Sub

Wenn es vielleicht nicht zu viel verlangt ist, Ich möchte noch zwei Comandbutton einfügen, Der erste Button soll einen in der Listbox1 Markierten Eintrag in die  Listbox2 einfügen und die Daten fixieren. Für Produkt Vergleiche. Das wenn man sucht auch mehrere Unterschiedliche Produkte in die Listbox 2 nachtragen kann. Der Zweite Button Soll die Listbox 2 wieder von den Daten reinigen. Also Löschen. 
Ich hoffe das ich nicht zu sehr mit der Tür ins Haus Falle und freue mich wenn Ihr helfen Könnt.

Viele Grüße und besten Dank im Voraus 

toto

[Steffl]

Hallo,

teste mal

Code:

Private Sub TextBox1_Change()
   Dim LRow As Long, i As Long, lngC As Long
   Dim wks1 As Worksheet
   Dim vntTabellen As Variant
  
   vntTabellen = Array("Gemüse", "Fleisch", "Trockenware") 'bitte ergänzen
   ListBox1.Clear
   For lngC = 0 To UBound(vntTabellen)
      Set wks1 = Worksheets(vntTabellen(lngC))
      LRow = wks1.Cells(Rows.Count, 1).End(xlUp).Row
      With Me
      
         For i = 3 To LRow
            If UCase(Left(wks1.Cells(i, 1).Text, Len(TextBox1.Text))) = UCase(TextBox1.Text) Then
               With .ListBox1
                  .ColumnCount = 8
                  .ColumnWidths = "7cm;3cm;3cm;3cm;3cm"
                  .AddItem wks1.Cells(i, 1)
                  .List(.ListCount - 1, 1) = wks1.Cells(i, 2)
                  .List(.ListCount - 1, 2) = wks1.Cells(i, 3)
                  .List(.ListCount - 1, 3) = wks1.Cells(i, 4).Text
                  .List(.ListCount - 1, 4) = wks1.Cells(i, 5).Text
                  .List(.ListCount - 1, 5) = wks1.Cells(i, 6)
                  .List(.ListCount - 1, 6) = wks1.Cells(i, 7)
                  .List(.ListCount - 1, 7) = wks1.Cells(i, 8)
                  
               End With
            End If
         Next i
      End With
   Next lngC
End Sub

[toto18]

Und innerhalb von Sekunden Glücklich bekommen es Funktioniert .... Ich sag ja eine Kleinigkeit für euch. Tausend Dank Dafür!!

[Käpt'n Blaubär]

Hallo toto,

bitte unterlasse in Zukunft das Verkleinern der Schrift.
Nicht jeder hat Adleraugen.

[toto18]

Wenn Du noch lust Zeit und Muse hast, Könntest Du mir vielleicht auch noch bei der Zweiten Frage helfen ?
"Wenn es vielleicht nicht zu viel verlangt ist, Ich möchte noch zwei Comandbutton einfügen, Der erste Button soll einen in der Listbox1 Markierten Eintrag in die  Listbox2 einfügen und die Daten fixieren. Für Produkt Vergleiche. Das wenn man sucht auch mehrere Unterschiedliche Produkte in die Listbox 2 nachtragen kann. Der Zweite Button Soll die Listbox 2 wieder von den Daten reinigen. Also Löschen."

[toto18]

Entschuldigung [b]Käpt'n Blaubär[/b]  kommt nicht wieder vor!

[Steffl]

Hallo,

zum zweiten Button

Code:

Private Sub CommandButton2_Click()

   ListBox2.Clear
End Sub

und was meinst Du mit den Daten fixieren?

[toto18]

Wenn ich in der Listbox1 eine Zeile Markiere soll diese in die Listbox2 eingefügt werden und Soll dort bestehen bleiben, bis ich eben die Liste wieder Lösche. Da in der ersten Listbox mehrere Lieferanten durchsucht werden. Möchte ich eben die untere Tabelle als Vergleich nutzen und mehrere Zeilen Oben Markieren und einfügen das man die Preise der Hersteller Vergleichen kann... Luxus wäre es natürlich noch wenn die Listbox 2 auch noch den Niedrigen Preis vielleicht Farblich hervorhebt.

[Steffl]

Hallo,

vielleicht so? (farblich markieren dürfte eher nicht gehen)

Code:

Private Sub CommandButton1_Click()
   Dim lngC As Long, lngA As Long
  
   For lngC = 0 To ListBox1.ListCount - 1
      If ListBox1.Selected(lngC) Then
         ListBox2.AddItem ListBox1(lngC, 0)
         ListBox2.List(lngA, 1) = ListBox1(lngC, 1)
         lngA = lngA + 1
      End If
   Next lngC
End Sub

[toto18]

Er Zeigt Leider Laufzeitfehler 13 an/ Typen sind Unverträglich

Private Sub CommandButton2_Click()
   Dim lngC As Long, lngA As Long
   
   For lngC = 0 To ListBox1.ListCount - 1
      If ListBox1.Selected(lngC) Then
         ListBox2.AddItem ListBox1(lngC, 0)  <-------Und Markiert diese Zeile
         ListBox2.List(lngA, 1) = ListBox1(lngC, 1)
         lngA = lngA + 1
      End If
   Next lngC
End Sub