Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
436to440
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
436to440
436to440
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
ReDim Array Anzahl Zeilen anpassen
04.06.2004 23:56:45
Robert
Hallo Zusammen,
ich habe ein Problem bei dem ich nicht recht weiterkomme.
Mit den Beispielen in der Recherche komme ich nicht klar.
Ich möchte in einer Userform eine Listbox über eine Array Variable füllen.
Grundsätzlich funktioniert das auch.
zb.
ReDim Array(0 To z, 0 To 9)
0 to z = Anzahl Zeilen in der Tabelle (z.B. 100 belegte Zeilen)
die durchsucht werden.
0 to 9 = Anzahl Spalten in der Listbox
lstZ = Anzahl Datensätze die gefunden wurden
Array(lstZ, 0) = Found.Offset(0, -36)
usw.
Wenn alle Zeilen durchsucht wurden werden z.B. 5 Datensätze gefunden.
Jetzt fülle ich die Listbox mit:
Userform.Listbox.List = Array
Jetzt sind im Array die 5 gefundenen Datensätze und die 95 leeren Datensätze enthalten.
Wie kann ich aber nur die 5 gefundenen datensätze in die Listbox laden?
Schon mal vielen Dank für Eure Hilfe.
Gruß
Robert

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ReDim Array Anzahl Zeilen anpassen
Boris
Hi Robert,
zeig doch mal deinen gesamten Code - oder noch besser: Lad mal Deine Datei hoch.
Prinzipiell arbeite mit ner If-Then-Abfrage, Redime das Array dann bei Treffer etc...
Oder zähle vorher alle Treffer, dimensioniere das Array direkt entsprechend und füll es dann - mit eben der If-Bedingung.
Grüße Boris
AW: ReDim Array Anzahl Zeilen anpassen
05.06.2004 00:38:03
Robert
Hallo Boris,
anbei der Code

Sub ListboxFuellen()
Dim z As Long, lstZ As Long
Dim FirstAddress As String, Search As String
Dim Found As Range
If ThisWorkbook.CustomDocumentProperties("UserformStart") = 1 Then Exit Sub
If [AK65536] = "" Then
z = [AK65536].End(xlUp).Row
Else
z = 65536
End If
Search = cboStationNeu 'Wert aus Combobox in der Userform
If Search = "" Then Exit Sub
frmStationen.lstDaten.ColumnCount = 10
With ActiveSheet.Range("AK1:AK" & z)
Set Found = .Find(Search, lookat:=xlPart)
If Found Is Nothing Then
lstDaten.Clear
On Error Resume Next
With frmStationen.lstDaten
.AddItem Cells(1, 1)
.List(0, 1) = Cells(1, 3)
.List(0, 2) = Cells(1, 4)
.List(0, 3) = Cells(1, 37) & " / " & Cells(1, 14)
.List(0, 4) = Cells(1, 40)
.List(0, 5) = Cells(1, 43)
.List(0, 6) = Cells(1, 48)
.List(0, 7) = Cells(1, 8)
.List(0, 8) = Cells(1, 9)
.List(0, 9) = Cells(1, 44) & " / " & Cells(1, 45)
End With
On Error GoTo 0
Exit Sub
End If
lstDaten.Clear
FirstAddress = Found.Address
frmStationen.lstDaten.ColumnWidths = "2,3cm;2,3cm;2,3cm;9,0cm;2,3cm;2,3cm;9cm;2,3cm;3cm;4,5cm"
ReDim MyArray(0 To z, 0 To 9)
If chkFilter.Value = False Then
On Error Resume Next
MyArray(0, 0) = Cells(1, Found.Column - 36)
MyArray(0, 1) = Cells(1, Found.Column - 34)
MyArray(0, 2) = Cells(1, Found.Column - 33)
MyArray(0, 3) = Cells(1, Found.Column) & " / " & Cells(1, Found.Column - 23)
MyArray(0, 4) = Cells(1, Found.Column + 3)
MyArray(0, 5) = Cells(1, Found.Column + 6)
MyArray(0, 6) = Cells(1, Found.Column + 11)
MyArray(0, 7) = Cells(1, Found.Column - 29)
MyArray(0, 8) = Cells(1, Found.Column - 28)
MyArray(0, 9) = Cells(1, Found.Column + 7) & " / " & Cells(1, Found.Column + 8)
lstZ = lstZ + 1
MyArray(lstZ, 0) = Found.Offset(0, -36)
MyArray(lstZ, 1) = Found.Offset(0, -34)
MyArray(lstZ, 2) = Found.Offset(0, -33)
MyArray(lstZ, 3) = Found.Offset(0, 0) & " / " & Found.Offset(0, -23)
MyArray(lstZ, 4) = Format(Found.Offset(0, 3), "#0.000")
MyArray(lstZ, 5) = Format(Found.Offset(0, 6), "#0.000")
MyArray(lstZ, 6) = Found.Offset(0, 11)
MyArray(lstZ, 7) = Found.Offset(0, -29)
MyArray(lstZ, 8) = Found.Offset(0, -28)
MyArray(lstZ, 9) = Found.Offset(0, 7) & " / " & Found.Offset(0, 8)
lstZ = lstZ + 1
Do
Set Found = .FindNext(Found)
If Found.Address = FirstAddress Then
frmStationen.lstDaten.List = MyArray
Exit Sub
End If
MyArray(lstZ, 0) = Found.Offset(0, -36)
MyArray(lstZ, 1) = Found.Offset(0, -34)
MyArray(lstZ, 2) = Found.Offset(0, -33)
MyArray(lstZ, 3) = Found.Offset(0, 0) & " / " & Found.Offset(0, -23)
MyArray(lstZ, 4) = Format(Found.Offset(0, 3), "#0.000")
MyArray(lstZ, 5) = Format(Found.Offset(0, 6), "#0.000")
MyArray(lstZ, 6) = Found.Offset(0, 11)
MyArray(lstZ, 7) = Found.Offset(0, -29)
MyArray(lstZ, 8) = Found.Offset(0, -28)
MyArray(lstZ, 9) = Found.Offset(0, 7) & " / " & Found.Offset(0, 8)
If Found.Row = z Then
frmStationen.lstDaten.List = MyArray
Exit Sub
End If
lstZ = lstZ + 1
Loop While Not Found Is Nothing
Else
With frmStationen.lstDaten
MyArray(0, 0) = Cells(1, Found.Column - 36)
MyArray(0, 1) = Cells(1, Found.Column - 34)
MyArray(0, 2) = Cells(1, Found.Column - 33)
MyArray(0, 3) = Cells(1, Found.Column) & " / " & Cells(1, Found.Column - 23)
MyArray(0, 4) = Cells(1, Found.Column + 3)
MyArray(0, 5) = Cells(1, Found.Column + 6)
MyArray(0, 6) = Cells(1, Found.Column + 11)
MyArray(0, 7) = Cells(1, Found.Column - 29)
MyArray(0, 8) = Cells(1, Found.Column - 28)
MyArray(0, 9) = Cells(1, Found.Column + 7) & " / " & Cells(1, Found.Column + 8)            lstZ = lstZ + 1
If cboStationsseite = Range(Found.Address).Offset(0, 7) Then
MyArray(lstZ, 0) = Found.Offset(0, -36)
MyArray(lstZ, 1) = Found.Offset(0, -34)
MyArray(lstZ, 2) = Found.Offset(0, -33)
MyArray(lstZ, 3) = Found.Offset(0, 0) & " / " & Found.Offset(0, -23)
MyArray(lstZ, 4) = Format(Found.Offset(0, 3), "#0.000")
MyArray(lstZ, 5) = Format(Found.Offset(0, 6), "#0.000")
MyArray(lstZ, 6) = Found.Offset(0, 11)
MyArray(lstZ, 7) = Found.Offset(0, -29)
MyArray(lstZ, 8) = Found.Offset(0, -28)
MyArray(lstZ, 9) = Found.Offset(0, 7) & " / " & Found.Offset(0, 8)
lstZ = lstZ + 1
End If
End With
Do
Set Found = .FindNext(Found)
If Found.Address = FirstAddress Then
frmStationen.lstDaten.List = MyArray
Exit Sub
End If
If cboStationsseite = Range(Found.Address).Offset(0, 7) Then
MyArray(lstZ, 0) = Found.Offset(0, -36)
MyArray(lstZ, 1) = Found.Offset(0, -34)
MyArray(lstZ, 2) = Found.Offset(0, -33)
MyArray(lstZ, 3) = Found.Offset(0, 0) & " / " & Found.Offset(0, -23)
MyArray(lstZ, 4) = Format(Found.Offset(0, 3), "#0.000")
MyArray(lstZ, 5) = Format(Found.Offset(0, 6), "#0.000")
MyArray(lstZ, 6) = Found.Offset(0, 11)
MyArray(lstZ, 7) = Found.Offset(0, -29)
MyArray(lstZ, 8) = Found.Offset(0, -28)
MyArray(lstZ, 9) = Found.Offset(0, 7) & " / " & Found.Offset(0, 8)
If Found.Row = z Then
frmStationen.lstDaten.List = MyArray
Exit Sub
End If
lstZ = lstZ + 1
End If
Loop While Not Found Is Nothing
On Error GoTo 0
End If
End With
frmStationen.lstDaten.List = MyArray
End Sub

Gruß Robert
Anzeige
Ich kann mir zwar einigermaßen vorstellen...
Boris
Hi Robert,
...was der Code macht - allerdings hab ich keine Lust, die Datei zum testen nachzubauen.
Kannst du sie nicht mal schnell hochladen?
Grüße Boris
AW: Ich kann mir zwar einigermaßen vorstellen...
05.06.2004 01:43:24
Robert
Hallo Boris,
ich habe das ganze zur Demonstration nachgebaut.
Es sind 7 benutzte Zeile vorhaden jedoch sollen die 3 gleichen Datensätze aus der Spalte A und die Überschrift übernommen werden.
In der Listbox sind aber die Überschrift und die 3 gefundenen Datensätze plus
die 3 leeren Datensätze.
Ich habe das ganze nur nachgebaut, da ich das Original nicht hochladen kann.
Ich hoffe Du kannst mir auch so helfen.
Vielen Dank
https://www.herber.de/bbs/user/7122.xls
Gruß Robert
Anzeige
AW: Ansatz
Martin
Hallo Robert,
der Code ist etwas unübersichtlich aber vom Prinzip her würde ich nicht einmal
ReDim MyArray(0 To z, 0 To 9)
verwenden, da hier die maximal mögliche Zeilenzahl reserviert wird und Nullzeilen vorprogrammiert werden, sondern bei jedem "Füllvorgang" mit
ReDim Preserve MyArray(0 To lstZ, 0 To 9)
die Zeilenzahl in MyArray um 1 erhöhen. Ggf. muß die Codezeile an verschiedenen Stellen eingefügt werden.
Gruß
Martin Beck
AW: Ansatz
Ulf
Redim Preserve ist nur für die letzte Dimension möglich!
Ulf
AW: Ansatz
05.06.2004 12:58:51
Nepumuk
Hallo Ulf,
ist doch kein Problem. Dann tauscht man einfach Zeilen mit Spalten.
ReDim Preserve MyArray(0 To 9, 0 To lstZ)
Und ändert die Zuweisung an die Listebox so:
ListBox1.List = WorksheetFunction.Transpose(MyArray)
Gruß
Nepumuk
Anzeige
AW: Ansatz
Ulf
Hab ich auch nicht behauptet, hab nur darauf hingewiesen, dass nur die
letzte Dimension mit Redim Preserve umdimensioniert werden kann.
Ulf
Asche auf's Haupt - anderer Ansatz
Martin
Hallo Ulf, Robert,
das stimmt, habe ich leider übersehen.
Hier noch ein anderer Ansatz. Ermittle zuerst, wie oft der Suchbegriff vorkommt, indem Du nach der Zeile
If Search = "" Then Exit Sub
einfügst

x = Application.WorksheetFunction.CountIf(ActiveSheet.Columns(1), Search)
und dann die ReDim Anweisung so formulierst:
ReDim MyArray(0 To x, 0 To 9)
Gruß und sorry
Martin Beck

AW: Asche auf's Haupt - anderer Ansatz
05.06.2004 15:08:21
Robert
Hallo Leute,
Vielen vielen Dank.
mit dem ReDim Preserve und der letzten Dimension habe ich noch nicht verstanden aber
der Vorschlag von Martin Beck funktioniert wunderbar.
Gruß Robert
Anzeige

136 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige