Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1520to1524
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
Inhaltsverzeichnis

Umstellen auf mehr als 10 Spalten

Umstellen auf mehr als 10 Spalten
19.10.2016 00:37:50
Thomas
Hallo Excelfreunde,
kann mir jemand dabei behilflich sein diesen Code so umzustellen das mehr als 10 Spalten funktionieren?
recht vielen dank für euer interesse.
liebe grüsse thomas
Dim lngIndex As Long
Dim lngCount As Long
Dim d As Long
ListBox1.Clear
ListBox1.ColumnCount = 10
TextBox1 = "1.10.2016"
TextBox2 = "30.10.2016"
'With ThisWorkbook.Worksheets(1)
lngCount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
For lngIndex = 2 To lngCount
If Cells(lngIndex, 1).Value >= CDate(TextBox1) And Cells(lngIndex, 1).Value ListBox1.AddItem
ListBox1.List(ListBox1.ListCount - 1, 0) = Worksheets(1).Cells(lngIndex, 1).Value
ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets(1).Cells(lngIndex, 2).Value
ListBox1.List(ListBox1.ListCount - 1, 2) = Worksheets(1).Cells(lngIndex, 3).Value
ListBox1.List(ListBox1.ListCount - 1, 3) = Worksheets(1).Cells(lngIndex, 4).Value
ListBox1.List(ListBox1.ListCount - 1, 4) = Worksheets(1).Cells(lngIndex, 5).Value
ListBox1.List(ListBox1.ListCount - 1, 5) = Worksheets(1).Cells(lngIndex, 6).Value
ListBox1.List(ListBox1.ListCount - 1, 6) = Worksheets(1).Cells(lngIndex, 7).Value
ListBox1.List(ListBox1.ListCount - 1, 7) = Worksheets(1).Cells(lngIndex, 8).Value
ListBox1.List(ListBox1.ListCount - 1, 8) = Worksheets(1).Cells(lngIndex, 9).Value
ListBox1.List(ListBox1.ListCount - 1, 9) = CStr(lngIndex)
End If
Next
' End With

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Umstellen auf mehr als 10 Spalten
19.10.2016 01:17:58
Martin
Hallo Thomas,
zunächst will ich dir kurz zeigen, dass dein Code stark gekürzt werden kann:
Sub Test()
Dim lngIndex As Long, lngCount As Long, d As Long, i as Integer
ListBox1.Clear
ListBox1.ColumnCount = 10
TextBox1 = "1.10.2016"
TextBox2 = "30.10.2016"
'With ThisWorkbook.Worksheets(1)
lngCount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
For lngIndex = 2 To lngCount
If Cells(lngIndex, 1).Value >= CDate(TextBox1) And Cells(lngIndex, 1).Value 
So, jetzt zu deiner Frage: Damit deine ListBox über 10 Spalten verwalten kann, musst du die Daten in ein zweidimensionales Array übertragen. Das Array übergibst du dann so an die ListBox:
ListBox1.List() = Application.Transpose(arrData)
Viele Grüße
Martin
Anzeige
AW: Umstellen auf mehr als 10 Spalten
19.10.2016 01:25:43
Thomas
Hallo Martin,
hab recht vielen dank das du dir dies mal angeschaut hast.
Und auch dafür das du den code schon bearbeitet hast.
leider weiss ich noch nicht wie man das mit dem zweidimensionales Array angehen könnte.
kannst du mir dies zeigen?
liebe grüsse thomas
AW: Umstellen auf mehr als 10 Spalten
19.10.2016 01:40:14
Martin
Hallo Thomas,
ich hoffe, dass ich keinen Fehler gemacht habe und es ungetestet sofort läuft.
Versuch es mal so:
    Dim lngIndex As Long, lngCount As Long, d As Long, i As Integer
Dim arrData As Variant
ListBox1.Clear
ListBox1.ColumnCount = 10
TextBox1 = "1.10.2016"
TextBox2 = "30.10.2016"
'With ThisWorkbook.Worksheets(1)
lngCount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
For lngIndex = 2 To lngCount
If Cells(lngIndex, 1).Value >= CDate(TextBox1) And Cells(lngIndex, 1).Value 
Viele Grüße
Martin
Anzeige
AW: Umstellen auf mehr als 10 Spalten
19.10.2016 01:54:55
Thomas
Hallo Martin,
du bist total cool, ich freu mich riesig das du dir das anschaust und vor allem so spät.
leider kommt hier
arrData(i, UBound(arrData)) = Worksheets(1).Cells(lngIndex, i).Value
" Index ausserhalb des gültigen bereichs "
schaust du noch mal?
viele liebe grüsse thomas
Ergänzung
19.10.2016 02:02:36
Martin
Hallo Thomas,
da hatte ich einen Flüchtigkeitsfehler. Ich hoffe, dass es jetzt klappt:
    Dim lngIndex As Long, lngCount As Long, d As Long, i As Integer
Dim arrData As Variant
TextBox1 = "1.10.2016"
TextBox2 = "30.10.2016"
'With ThisWorkbook.Worksheets(1)
lngCount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
For lngIndex = 2 To lngCount
If Cells(lngIndex, 1).Value >= CDate(TextBox1) And Cells(lngIndex, 1).Value 
Zudem habe ich noch folgende überflüssigen Zeilen entfernt:

ListBox1.Clear
ListBox1.ColumnCount = 10
Durch die Zuweisung des Arrays an die ListBox werden alle vorherigen Einträge automatisch überschrieben und die Array-Dimensionierung (also die Anzahl der Zeilen und Spalten) auf die ListBox übertragen.
Viele Grüße
Martin
Anzeige
wahnsinn es klappt. besten dank an martin
19.10.2016 02:23:27
Thomas
Hallo Martin,
es klappt fantastisch, Du kannst Dir gar nicht vorstellen wie viel Stunden ich das versucht habe.
Bin total Happy ich freu mich riesig. Das hätte ich mir die nächsten Jahre nicht erlesen können.
hab recht vielen vielen dank dafür
liebe grüsse thomas
AW: wahnsinn es klappt. besten dank an martin
19.10.2016 02:31:53
Martin
Hallo Thomas,
scheinbar bin ich zu dieser Zeit nicht mehr konzentrationsfähig. Ich habe da noch einen Fehler drin, der bei nur einem Treffer oder keinem Treffer zu einer Fehlermeldung führen dürfte. Hier die Korrektur:
    Dim lngIndex As Long, lngCount As Long, d As Long, i As Integer
Dim arrData As Variant, arrData2 As Variant
TextBox1 = "1.10.2016"
TextBox2 = "30.10.2016"
'With ThisWorkbook.Worksheets(1)
lngCount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
For lngIndex = 2 To lngCount
If Cells(lngIndex, 1).Value >= CDate(TextBox1) And Cells(lngIndex, 1).Value 
Falls es noch Probleme gibt, mach ich morgen weiter. Jetzt muss ich ins Bett gehen. Gute Nacht!
Viele Grüße
Martin
Anzeige
besten dank an martin habe es ausgetauscht
19.10.2016 02:48:50
Thomas
Hallo martin,
habe es gleich getauscht. ich sag ja super kerl bist du. Hoffentlich wirke ich nicht so schleimig aber ich bin richtig riesig froh über deine Lösung. ich glaube ich habe alle Beiträge im netz gelesen um eine Lösung zu finden.
hab vielen vielen dank
liebe grüsse thomas
AW: noch ein Optimirrungsansatz
19.10.2016 09:03:51
Daniel
Hallo Martin
Nur so ne Idee, mit
WorksheetFunctions.CountIfs(Datumsspalte' ">=DatumVon", Datumsspalte, "

Kannst du doch vorab schon ermitteln, wieviele Zeilen in die Listbox kommen.
Damit kannst du das Array gleich auf die richtige Größe dimensionieren.
Das spart das Redim Preserve und infolge das Transpose, weil du zum Einlesen dann nicht mehr Zeilen und Spalten tauschen musst.
Gruß Daniel
Anzeige
bin sehr dran interessiert
19.10.2016 23:09:44
Thomas
Hallo Martin,
sorry das ich mich erst jetzt melde. Ich habe dein Macro in meine Hauptdatei eingebaut, hatt ein wenig gedauert aber es passt.
Ich versuche seid einiger zeit dein vorschlag umzusetzen
bin jetzt bei
Dim aa
aa = Application.WorksheetFunction.CountIfs(Worksheets(1).Range("A:A") & ">=textbox_von", Worksheets(1).Range("A:A") & " MsgBox aa
angelangt aber egal was ich versuche ich bekomme einfach keine zahl in aa rein.
Die Spalte A ist die datumsspalte, und "textbox_von" "textbox_bis" sind jetzt die textboxen.
Siehst Du was ich falsch mache?
liebe grüsse thomas
Anzeige
dies habe ich geschafft aber wie weiter?
20.10.2016 01:07:07
Thomas
Hallo Martin,
diesen Syntax habe ich geknackt nun habe ich die Anzahl der Datensätze
Dim Anzahl_daten As Integer
Anzahl_daten = Application.WorksheetFunction.CountIfs(Worksheets(1).Range("A:A"), ">=" & CDbl(CDate(Me.textbox_von)), Worksheets(1).Range("A:A"), " MsgBox Anzahl_daten
aber wie geht es weiter? kannst du mir sagen wie ich das Array richtig dimensionieren kann?
VBA macht Spass wenn ich nur nicht so viel lücken haben würde man man.
hab schon mal recht vielen dank
mfg thomas
AW: dies habe ich geschafft aber wie weiter?
20.10.2016 08:22:18
Martin
Hallo Thomas,
ich bin eigentlich kein Nachtschwärmer ;-)
Es ist noch keine Meister vom Himmel gefallen und wie alle anderen habe auch ich mal klein angefangen. Bleib am Ball und versuch die Codes zu verstehen, so schließt du die Lücken am schnellsten und lernst schnell dazu. Hier der Code mit der richtigen Dimensionierung des Arrays (...wie immer ungetestest).
    Dim lngIndex As Long, i As Integer, lngCount As Long, lngCount2 As Long
Dim arrData As Variant
lngCount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
Anzahl_daten = Application.WorksheetFunction.CountIfs(Worksheets(1).Range("A:A"), _
">=" & CDbl(CDate(Me.textbox_von)), Worksheets(1).Range("A:A"), _
"= CDate(TextBox1) And Cells(lngIndex, 1).Value 
Viele Grüße
Martin
Anzeige
...du hast ja deine TextBoxen umbenannt...
20.10.2016 08:30:14
Martin
Hallo Thomas,
mit der neuen Bezeichnung deiner TextBoxen muss noch diese Zeile geändert werden:
If Cells(lngIndex, 1).Value >= CDate(textbox_von) And Cells(lngIndex, 1).Value 
Viele Grüße
Martin
AW: ...du hast ja deine TextBoxen umbenannt...
20.10.2016 08:58:16
Martin
Hallo Thomas,
nun ist mir auch noch aufgefallen, dass ich vergessen hatte die Variable Dim Anzahl_daten As
Long
zu deklarieren. Eigentlich ist das dein Glück, denn somit zeige ich dir noch eine dritte Möglichkeit, in der du diese Variabel nicht einmal benötigst. Wie du siehst, gibt es mit VBA (fast) immer mehrere Wege sein Ziel zu erreichen:
    Dim lngIndex As Long, i As Integer, lngCount As Long, lngCount2 As Long
Dim arrData As Variant
lngCount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
ReDim arrData(1 To lngCount, 1 To 10)
For lngIndex = 2 To lngCount
If Cells(lngIndex, 1).Value >= CDate(textbox_von) And Cells(lngIndex, 1).Value 
Viele Grüße
Martin
Anzeige
habe alle versionen getestet..
20.10.2016 12:15:11
Thomas
Hallo Martin,
ich finde es cool das du noch das Macro besser machst, besten dank dafür.
bei der letzten variante muss noch ein kleiner wurm drin sein hier
'ReDim Preserve arrData(1 To lngCount2, 1 To 10)
schreibt er "index ausserhalb des bereichs"
Wenn ich diese zeile aus dem rennen nehme dann läuft der Code durch.
Allerdings viel mir auf das dann in der listbox ganz viele leere zeilen am ende drinn sind.
die leeren zeilen in der listbox sind beim vorletzten code nicht drin.
deshalb ist dieser zur zeit mein favorit
Dim lngIndex As Long, i As Integer, lngCount As Long, lngCount2 As Long
Dim arrData As Variant
Dim Anzahl_daten As Integer
textbox_von = "5.10.2016"
textbox_bis = "30.10.2016"
lngCount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
Anzahl_daten = Application.WorksheetFunction.CountIfs(Worksheets(1).Range("A:A"), _
">=" & CDbl(CDate(Me.textbox_von)), Worksheets(1).Range("A:A"), _
" If Anzahl_daten = 0 Then
ListBox1.Clear
Exit Sub
End If
ReDim arrData(1 To Anzahl_daten, 1 To 10)
For lngIndex = 2 To lngCount
If Cells(lngIndex, 1).Value >= CDate(textbox_von) And Cells(lngIndex, 1).Value lngCount2 = lngCount2 + 1
For i = 1 To 9
arrData(lngCount2, i) = Worksheets(1).Cells(lngIndex, i).Value
Next
arrData(lngCount2, 10) = CStr(lngIndex)
'#####################################################################################
arrData(lngCount2, 3) = Format("hh:mm:ss") ' dies geht noch nicht
'###################################################################################
End If
Next
ListBox1.List() = arrData
hier habe ich aber auch noch eine baustelle. ich möchte gern die 4. Spalte in der Listbox als uhrzeit haben. Mit dieser Schleife geht es auch
Dim uhrzeitspalten As Integer
With ListBox1
For uhrzeitspalten = 0 To .ListCount - 1
'.List(uhrzeitspalten, 1) = Format(.List(uhrzeitspalten, 1), "dd.MM.yyyy")
'.List(uhrzeitspalten, 2) = Format(.List(uhrzeitspalten, 2), "dd.MM.yyyy")
.List(uhrzeitspalten, 3) = Format(.List(uhrzeitspalten, 3), "hh:mm:ss")
.List(uhrzeitspalten, 4) = Format(.List(uhrzeitspalten, 4), "hh:mm:ss")
Next
End With
aber ich frage mich ob dies auch ohne schleife gehen könnte.
hast du da auch eine idee?
ich lese auch noch ein wenig vielleicht finde ich dazu auch noch was.
in jedenfalls hab vielen vielen dank für die Unterstützung
liebe grüsse thomas
Anzeige
habe die uhrzeit im griff
20.10.2016 12:44:29
Thomas
Hallo Martin,
das mit der Uhrzeit geht mit, dann geht es gleich beim einlesen,
For i = 1 To 9
arrData(lngCount2, i) = Worksheets(1).Cells(lngIndex, i).Value
arrData(lngCount2, 3) = Format(Worksheets(1).Cells(lngIndex, 3), "hh:mm")
Next
siehst du da ein problem wenn man das so macht?
liebe grüsse thomas
AW: habe die uhrzeit im griff
20.10.2016 13:10:24
Daniel
Hi
nunja es ist nicht sinnvoll, dass du das in der Schleife über die Spalten machst, besser ist danach (einmal befüllen reicht ja)
wenn die Quellzelle schon passend formatiert ist, kannst du auch den angezeigten Text aus der Quellzelle direkt übernehmen:
For i = 1 To 9
arrData(lngCount2, i) = Worksheets(1).Cells(lngIndex, i).Value
Next
arrData(lngCount2, 3) = Worksheets(1).Cells(lngIndex, 3).Text
Gruß Daniel
mache ich so besten dank
20.10.2016 13:20:28
Thomas
Hallo Daniel,
ich mache das dann lieber so es scheint auch schneller zu sein.
hab vielen vielen dank Daniel
liebe grüsse thomas

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige