Office: Listbox: Ausgewählte Einträge kopieren

Guten Tag zusammen

Ich habe eine Listbox, welche mir die Zellen A und B einer "Datentabelle" anzeigt. In der Zeile A ist die Marke eines Gerätes vermerkt, in der Zeile B der Typ. Folgende Spalten (B,C,...) sind mit weiteren Infos zum jeweiligen Gerät gefüllt.

Wie kann ich jetzt, nach dem Anwälen der Geräte in der Listbox, die ausgwählten Spalten zb. A2 bis I2 in eine neue Tabelle kopieren lassen. In dieser neuen Tabelle würde ich gerne selber definieren welcher Eintrat wo hinkommt. Bsp: A2 aus der "Datentabelle" ist in der Drucktabelle B5, B2 ist B6, C2 ist B7, usw.


Danke für eure Hinweise.



Gruss Mani

:)

 

Hallo Mani,

wenn Du eine 2-spaltige List-/ComboBox verwendest, dann erweitere diese per VBA-Code um eine weitere Spalte, in die Du dann die Zeilennr. einliest (die jedoch nicht angezeigt wird. Hier ein Beispiel mit einer 3-spaltigen ComboBox :

VBA-Code:

Private Sub UserForm_Activate()     Dim lngZ As Long, lngLZ As Long     With Sheets("Datentabelle") 'Daten aus "Datentabelle" in Combobox1 anzeigen         lngLZ = .Cells(Rows.Count, 1).End(xlUp).Row 'Letzte Zeile der Spalte A         For lngZ = 2 To lngLZ             ComboBox1.AddItem             ComboBox1.List(ComboBox1.ListCount - 1, 0) = .Cells(lngZ, 1)             ComboBox1.List(ComboBox1.ListCount - 1, 1) = .Cells(lngZ, 2)             ComboBox1.List(ComboBox1.ListCount - 1, 2) = lngZ 'Zeilennr.         Next     End With End Sub Private Sub CommandButton1_Click()     Dim lngZ As Long     lngZ = ComboBox1.List(ComboBox1.ListIndex, 2)     'Kopieren-Button : Hier nur Anzeige der Zeilennr. :     MsgBox lngZ     Call Kopieren(lngZ) 'Aufruf des Kopieren-Makros mit Zeilennr. End Sub Sub Kopieren(lngZ)     'Das eigentliche Kopieren-Makro :     Dim wsQuelle As Worksheet, wsZiel As Worksheet     Dim lngLZ As Long     Set wsQuelle = Sheets("Datentabelle")     Set wsZiel = Sheets("Drucktabelle")     'Neue Zeile in Drucktabelle ermitteln :     lngLZ = wsZiel.Cells(Rows.Count, 1).End(xlUp).Row + 1     wsZiel.Cells(lngLZ, 1) = wsQuelle.Cells(lngZ, 1) 'Spalte A nach Spalte A kopieren     wsZiel.Cells(lngLZ, 2) = wsQuelle.Cells(lngZ, 3) 'Spalte C nach Spalte B kopieren     wsZiel.Cells(lngLZ, 3) = wsQuelle.Cells(lngZ, 5) 'Spalte E nach Spalte C kopieren     wsZiel.Cells(lngLZ, 4) = wsQuelle.Cells(lngZ, 9) 'Spalte I nach Spalte D kopieren     wsZiel.Cells(lngLZ, 5) = wsQuelle.Cells(lngZ, 4) 'Spalte D nach Spalte E kopieren     'etc. End Sub

Code eingefügt mit Syntaxhighlighter 4.15

 

Hallo NoNet

Vielen Dank für deine Antwort. Werde es heute Abend ausprobieren.
Eine Frage habe ich aber noch. Ich möchte gerne, dass der erste angwählte Eintrag in jene Zeilen, bzw. Spalten geschrieben wird in der anderen Tabelle und der zweite Eintrag in die gleiche Tabelle, jedoch in andere Zeilen, bzw. Spalten. Ist dies möglich?


Gruss Mani

 

Hallo Mani,

zu deiner Frage :

In unterschiedliche SPALTEN wird ja bereits kopiert - siehe Code :

wsZiel.Cells(lngLZ, 3) = wsQuelle.Cells(lngZ, 5) 'Spalte E nach Spalte C kopieren

Du kannst natürlich auch in beliebige Zellen kopieren :

wsZiel.[L20] = wsQuelle.Cells(lngZ, 5) 'Spalte E nach Zelle L20 kopieren

 

\@NoNet

nur als Variante zur Befüllung der Combobox (spart zwar eine Schleife, ersetzt aber den alten Inhalt der Liste):
Code:

Grüße
EarlFred

 

Hallo Earlfred


Danke für deine Variante. Was bringt mir diese? Wo muss ich sie einfügen?


Gruss Mani

 

Guten Abend

Mit der Combobox habe ich noch folgendes Problem:
Wenn ich den Pfeil nach unten drücke, werden mir die Zeile A und B angezeigt (wie gewünscht). Wenn ich den Eintrag aber anschliessend anklicke wird mir nur noch die Zeile A im Fenster angezeigt. Wie kann ich es einstellen, dass auch da Zeile A und B angezeigt wird?


Gruss Mani

 

Hallo zusammen

Ich habe nun eine zweite Combobox in meine Userform eingefügt. Es funktioniert auch soweit, ausser das kopieren. Es kopiert mir das ausgewählte Gerät aus der ersten Combobox in meine Beiden Zielfelder. Was muss ich ergänzen, damit mir auch das in der zweiten Combobox ausgewählte Gerät kopiert wird?

Code:

Danke und Gruss Mani

 

Hallo Manni,

zu 1.) : In der Combobox kann immer nur 1 Datenfeld angezeigt werden (BoundColumn), während in der aufgeklappten Liste mehrere Spalen angezeigt werden können (ColumnsCount)

zu 2.) : Deine Anforderung hat sich im Vergleich zur Ausgangsfrage ja etwas erweitert. Es wäre hilfreich, solche Anforderungen gleich zu Beginn mit anzugeben, da ansonsten mehrfache (unnötige) Codekorrekturen notwendig sind.
Dass Du das nicht alleine hinbekommst, zeigt Dein "erweiterter" Code, der noch zahlreiche Fehler beinhaltet.

Hier der angepasste Code :

VBA-Code:

Private Sub UserForm_Activate()     Dim lngZ As Long, lngLZ As Long     With Sheets("Gerätedatenbank") 'Daten aus "Gerätedatenbank" in Combobox1 anzeigen         lngLZ = .Cells(Rows.Count, 1).End(xlUp).Row 'Letzte Zeile der Spalte A         For lngZ = 2 To lngLZ             ComboBox1.AddItem             ComboBox1.List(ComboBox1.ListCount - 1, 0) = .Cells(lngZ, 1)             ComboBox1.List(ComboBox1.ListCount - 1, 1) = .Cells(lngZ, 2)             ComboBox1.List(ComboBox1.ListCount - 1, 2) = lngZ 'Zeilennr.             ComboBox2.AddItem             ComboBox2.List(ComboBox2.ListCount - 1, 0) = .Cells(lngZ, 1)             ComboBox2.List(ComboBox2.ListCount - 1, 1) = .Cells(lngZ, 2)             ComboBox2.List(ComboBox2.ListCount - 1, 2) = lngZ 'Zeilennr.         Next     End With End Sub Private Sub CommandButton1_Click()     Dim lngZ1 As Long, lngZ2 As Long     lngZ1 = ComboBox1.List(ComboBox1.ListIndex, 2)     lngZ2 = ComboBox2.List(ComboBox2.ListIndex, 2)     Kopieren lngZ1, lngZ2 'Aufruf des Kopieren-Makros mit Zeilennr. End Sub Sub Kopieren(lngZ1, lngZ2)     'Das eigentliche Kopieren-Makro :     Dim wsQuelle As Worksheet, wsZiel As Worksheet     Set wsQuelle = Sheets("Gerätedatenbank")     Set wsZiel = Sheets("Drucken")     'Daten der 1.ComboBox kopieren :     wsZiel.[D12] = wsQuelle.Cells(lngZ1, 1) 'Spalte A nach Spalte A kopieren     wsZiel.[D13] = wsQuelle.Cells(lngZ1, 2) 'Spalte C nach Spalte B kopieren     wsZiel.[D14] = wsQuelle.Cells(lngZ1, 3) 'Spalte E nach Spalte C kopieren     wsZiel.[D15] = wsQuelle.Cells(lngZ1, 4) 'Spalte I nach Spalte D kopieren     wsZiel.[D16] = wsQuelle.Cells(lngZ1, 5) 'Spalte D nach Spalte E kopieren     wsZiel.[D17] = wsQuelle.Cells(lngZ1, 6) 'Spalte D nach Spalte E kopieren     wsZiel.[D18] = wsQuelle.Cells(lngZ1, 7) 'Spalte D nach Spalte E kopieren     wsZiel.[D19] = wsQuelle.Cells(lngZ1, 8) 'Spalte D nach Spalte E kopieren     wsZiel.[D20] = wsQuelle.Cells(lngZ1, 9) 'Spalte D nach Spalte E kopieren     wsZiel.[D21] = wsQuelle.Cells(lngZ1, 10) 'Spalte D nach Spalte E kopieren     wsZiel.[D22] = wsQuelle.Cells(lngZ1, 11) 'Spalte D nach Spalte E kopieren     wsZiel.[D24] = wsQuelle.Cells(lngZ1, 12) 'Spalte D nach Spalte E kopieren     wsZiel.[D25] = wsQuelle.Cells(lngZ1, 13) 'Spalte D nach Spalte E kopieren     wsZiel.[D26] = wsQuelle.Cells(lngZ1, 14) 'Spalte D nach Spalte E kopieren     'Daten der 2.ComboBox kopieren :     wsZiel.[F12] = wsQuelle.Cells(lngZ2, 1) 'Spalte A nach Spalte A kopieren     wsZiel.[F13] = wsQuelle.Cells(lngZ2, 2) 'Spalte C nach Spalte B kopieren     wsZiel.[F14] = wsQuelle.Cells(lngZ2, 3) 'Spalte E nach Spalte C kopieren     wsZiel.[F15] = wsQuelle.Cells(lngZ2, 4) 'Spalte I nach Spalte D kopieren     wsZiel.[F16] = wsQuelle.Cells(lngZ2, 5) 'Spalte D nach Spalte E kopieren     wsZiel.[F17] = wsQuelle.Cells(lngZ2, 6) 'Spalte D nach Spalte E kopieren     wsZiel.[F18] = wsQuelle.Cells(lngZ2, 7) 'Spalte D nach Spalte E kopieren     wsZiel.[F19] = wsQuelle.Cells(lngZ2, 8) 'Spalte D nach Spalte E kopieren     wsZiel.[F20] = wsQuelle.Cells(lngZ2, 9) 'Spalte D nach Spalte E kopieren     wsZiel.[F21] = wsQuelle.Cells(lngZ2, 10) 'Spalte D nach Spalte E kopieren     wsZiel.[F22] = wsQuelle.Cells(lngZ2, 11) 'Spalte D nach Spalte E kopieren     wsZiel.[F24] = wsQuelle.Cells(lngZ2, 12) 'Spalte D nach Spalte E kopieren     wsZiel.[F25] = wsQuelle.Cells(lngZ2, 13) 'Spalte D nach Spalte E kopieren     wsZiel.[F26] = wsQuelle.Cells(lngZ2, 14) 'Spalte D nach Spalte E kopieren     'etc. End Sub

Code eingefügt mit Syntaxhighlighter 4.15

 

Hallo NoNet

Danke für deine Korrektur. Ich werde mich das nächste mal von Beginn weg klar ausdrücken. Habe es bewusst so formuliert, dass meine Anfrage nicht zu gross/ zu kompliziert erscheint.

Vielen Dank nochmals für deine Mühe, werde es heute Abend einfügen.


Gruss Mani

 

Hey, vielen Dank. Der Code hat prima geklappt. Ein Problem habe ich jedoch noch:

Wenn ich nur in einer Listbox einen Eintrag auswähle (Box 1) und die Box 2 freibleibt, zeigt es mir einen Fehler an und ich kann so die Einträge nicht kopieren. Ich nehme an, da muss noch irgend eine "IF" Funktion rein.

Kannst du mir da bitte nochmals helfen.

Vielen Dank