Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
612to616
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
612to616
612to616
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Mehrspaltige ListBox dynamisch befüllen

Mehrspaltige ListBox dynamisch befüllen
20.05.2005 20:50:20
Marcel
Hallo Excel-Freunde
Ich möchte eine mehrspaltige ListBox dynamisch befüllen.
Zuerst habe ich ein Befüllung mit festem Bezug wie folgt gemacht:
With ListBox2
.ColumnCount = 3
.RowSource = "E37:K47"
.ColumnHeads = True
.ColumnWidths = "1cm;1,8cm;1,5cm"
.ListStyle = fmListStylePlain
End With
Funktioniert - so weit so gut.
Dann habe ich versucht, die ListBox dynamisch zu befüllen, d.h. nur diejenigen Datensätze sollen angezeigt werden, die den gleichen Wert wie TextBox1 aufweisen.
'Listbox dynamisch befüllen
Sheets("SALES-MP").Select
Dim Blatt1 As Worksheet
Dim Q As Long
Set Blatt1 = ActiveWorkbook.Worksheets("SALES-MP")
With ListBox2
.ColumnCount = 3
.ColumnHeads = True
.ColumnWidths = "1cm;1,8cm;1,5cm"
For Q = 1 To Blatt1.UsedRange.Rows.Count
If Cells(Q, 1).Value = TextBox1.Value Then
.AddItem Cells(Q, 4).Value
.AddItem Cells(Q, 5).Value
.AddItem Cells(Q, 6).Value
End If
Next Q
End With
Die Selektion funktioniert - er zeigt nun die richtigen Datensätze an - doch alle in der ersten Spalte untereinander statt nebeneinander.
Wie kann man das lösen?
Vielen Dank für eine Antwort
Schöne Grüsse
Marcel

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrspaltige ListBox dynamisch befüllen
20.05.2005 22:01:39
Beni
Hallo Marcel,
mit der zweidimensionalen Array und AddItem, gibt es keine .ColumnHeads,
wenn mann eine .ColumnHeads will, muss man die gesammelten Daten temporär in eine Tabelle kopieren und diese Daten und mit .RowSource verknüpfen.
Gruss Beni
Dim arrValues1() As Variant
Dim Q As Long
With Sheets("SALES-MP")
For Q = 1 To .UsedRange.Rows.Count
If Cells(Q, 1).Value = CInt(TextBox1) Then
ReDim Preserve arrValues1(0 To 2, 0 To intRow)
arrValues1(0, intRow) = Cells(Q, 1)
arrValues1(1, intRow) = Cells(Q, 2)
arrValues1(2, intRow) = Cells(Q, 3)
intRow = intRow + 1
End If
Next Q
End With
With ListBox2
.ColumnCount = 3
.ColumnHeads = False
.ColumnWidths = "1cm;1,8cm;1,5cm"
.Column = arrValues1
End With
Anzeige
AW: Mehrspaltige ListBox dynamisch befüllen
21.05.2005 10:01:28
Marcel
Hallo Beni
Vielen Dank für den Input. Habe das mal versucht. Am Schluss erscheint der Debugger mit folgender Fehlermeldung:
Laufzeitfehler381: Eigenschaft Column konnte nicht gesetzt werden. Index des Eigenschaftenfeldes ungültig.
Code:
.Column = arrValues1
Habe mit verschiedenen Eigenschaften von Column rumgeübt - Leider ohne Erfolg.
Kannst Du mir da weiterhelfen? Was könnte das sein?
Viele Grüsse
Marcel
AW: Mehrspaltige ListBox dynamisch befüllen
21.05.2005 11:52:58
Beni
Dim arrValues1() As Variant
Dim Q As Long
With Sheets("SALES-MP")
For Q = 1 To .UsedRange.Rows.Count
If Cells(Q, 1).Value = TextBox1 Then
ReDim Preserve arrValues1(0 To 2, 0 To intRow)
arrValues1(0, intRow) = Cells(Q, 1)
arrValues1(1, intRow) = Cells(Q, 2)
arrValues1(2, intRow) = Cells(Q, 3)
intRow = intRow + 1
End If
Next Q
End With
If Not intRow = 0 Then
With ListBox2
.Clear
.ColumnCount = 3
.ColumnHeads = False
.ColumnWidths = "1cm;1,8cm;1,5cm"
.Column = arrValues1
End With
End If
Anzeige
AW: noch eine kleine Verbesserung
21.05.2005 12:08:03
Beni
Hallo Marcel,
ich habe noch eine kleine Verbesserung angbracht.
Gruss Beni
Dim arrValues1() As Variant
Dim Q As Long
With Sheets("SALES-MP")
For Q = 1 To .UsedRange.Rows.Count
If Cells(Q, 1).Value = TextBox1 Then
ReDim Preserve arrValues1(0 To 2, 0 To intRow)
arrValues1(0, intRow) = Cells(Q, 1)
arrValues1(1, intRow) = Cells(Q, 2)
arrValues1(2, intRow) = Cells(Q, 3)
intRow = intRow + 1
End If
Next Q
End With
With ListBox2
If Not intRow = 0 Then
.ColumnCount = 3
.ColumnHeads = False
.ColumnWidths = "1cm;1,8cm;1,5cm"
.Column = arrValues1
Else
.Clear
.ColumnWidths = "4cm"
.AddItem "kein Wert gefunden"
End If
End With
Anzeige
AW: noch eine kleine Verbesserung
21.05.2005 17:49:41
Marcel
Hallo
Vielen Dank für den Input. In der einfachen Anwendung funktioniert das.
Nun habe ich folgendes Problem: Das UserForm enthält Multiseiten und darin sind 16 dieser Listboxen. Ich habe nun mal versucht, das wie folgt zu programmieren:
Sheets("SALES-MP").Select
Dim arrValues1() As Variant
Dim Q As Long
Dim arrValues2() As Variant
Dim QB As Long
With Sheets("SALES-MP")
For Q = 1 To .UsedRange.Rows.Count
If Cells(Q, 1).Value = TextBox1 Then
ReDim Preserve arrValues1(0 To 6, 0 To intRow)
arrValues1(0, intRow) = Cells(Q, 4)
arrValues1(1, intRow) = Cells(Q, 5)
arrValues1(2, intRow) = Cells(Q, 6)
arrValues1(3, intRow) = Cells(Q, 7)
arrValues1(4, intRow) = Cells(Q, 8)
arrValues1(5, intRow) = Cells(Q, 9)
arrValues1(6, intRow) = Cells(Q, 10)
intRow = intRow + 1
End If
Next Q
End With
With Sheets("SALES-MP")

For QB = 1 To .UsedRange.Rows.Count
If Cells(QB, 1).Value = TextBox1 Then
ReDim Preserve arrValues2(7 To 13, 0 To intRow)
arrValues2(7, intRow) = Cells(QB, 11)
arrValues2(8, intRow) = Cells(QB, 12)
arrValues2(9, intRow) = Cells(QB, 13)
arrValues2(10, intRow) = Cells(QB, 14)
arrValues2(11, intRow) = Cells(QB, 15)
arrValues2(12, intRow) = Cells(QB, 16)
arrValues2(13, intRow) = Cells(QB, 17)
intRow = intRow + 1
End If
Next QB
End With
With ListBox2
If Not intRow = 0 Then
.ColumnCount = 7
.ColumnHeads = False
.ColumnWidths = "1cm;1,8cm;1,3cm;1,3cm;1,3cm;1,3cm;1,3cm"
.Column = arrValues1
Else
.Clear
.ColumnWidths = "4cm"
.AddItem "kein Wert gefunden"
End If
End With
With ListBox3
If Not intRow = 0 Then
.ColumnCount = 7
.ColumnHeads = False
.ColumnWidths = "1cm;1,8cm;1,3cm;1,3cm;1,3cm;1,3cm;1,3cm"
.Column = arrValues2
Else
.Clear
.ColumnWidths = "4cm"
.AddItem "kein Wert gefunden"
End If
End With
Wenn ich das so teste, werden nur die Werte der ersten ListBox angezeigt - die zweite ist leer. Wenn ich den Code deaktiviere ('), dann funktionieren sowohl die erste wie auch die zweite ListBox. Wie kann man nun erreichen, dass beide ListBoxes gleichzeitig befüllt werden?
Vielen Dank für eine Antwort
Schöne Grüsse
Marcel
Anzeige
AW: noch eine kleine Verbesserung
21.05.2005 20:38:27
Beni
Hallo Marcel,
arrValues2(0 To 6, 0 To intRow)
0 To 6 ist der Spalenindex der Listbox und diese beginnen mit 0
arrValues2(0, intRow) = Cells(QB, 11)
0 , intRow ist der Zeilenindex der Listbox und diese beginnen auch mit 0 und nach jedem Eintrag um eins erhöht.
Gruss Beni
Dim arrValues1() As Variant
Dim Q As Long
Dim arrValues2() As Variant
Dim QB As Long
With Sheets("SALES-MP")
For Q = 1 To .UsedRange.Rows.Count
If Cells(Q, 1).Value = TextBox1 Then
ReDim Preserve arrValues1(0 To 6, 0 To intRow)
arrValues1(0, intRow) = Cells(Q, 4)
arrValues1(1, intRow) = Cells(Q, 5)
arrValues1(2, intRow) = Cells(Q, 6)
arrValues1(3, intRow) = Cells(Q, 7)
arrValues1(4, intRow) = Cells(Q, 8)
arrValues1(5, intRow) = Cells(Q, 9)
arrValues1(6, intRow) = Cells(Q, 10)
intRow = intRow + 1
End If
Next Q
intRow = 0
For QB = 1 To .UsedRange.Rows.Count
If Cells(QB, 1).Value = TextBox1 Then
ReDim Preserve arrValues2(0 To 6, 0 To intRow)
arrValues2(0, intRow) = Cells(QB, 11)
arrValues2(1, intRow) = Cells(QB, 12)
arrValues2(2, intRow) = Cells(QB, 13)
arrValues2(3, intRow) = Cells(QB, 14)
arrValues2(4, intRow) = Cells(QB, 15)
arrValues2(5, intRow) = Cells(QB, 16)
arrValues2(6, intRow) = Cells(QB, 17)
intRow = intRow + 1
End If
Next QB
End With
With ListBox2
If Not intRow = 0 Then
.ColumnCount = 7
.ColumnHeads = False
.ColumnWidths = "1cm;1,8cm;1,3cm;1,3cm;1,3cm;1,3cm;1,3cm"
.Column = arrValues1
Else
.Clear
.ColumnWidths = "4cm"
.AddItem "kein Wert gefunden"
End If
End With
With ListBox3
If Not intRow = 0 Then
.ColumnCount = 7
.ColumnHeads = False
.ColumnWidths = "1cm;1,8cm;1,3cm;1,3cm;1,3cm;1,3cm;1,3cm"
.Column = arrValues2
Else
.Clear
.ColumnWidths = "4cm"
.AddItem "kein Wert gefunden"
End If
End With
Anzeige
AW: noch eine kleine Verbesserung
23.05.2005 01:25:53
Marcel
Hallo
Vielen Dank für die Unterstützung. Es funktioniert alles wunderbar.
Du hast mir sehr geholfen.
Viele Grüsse
Marcel

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige