Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

10 Datensätze dann wieder runter und wieder 10

10 Datensätze dann wieder runter und wieder 10
09.11.2016 16:43:16
Max2
Hallo Leute,
ich werte per Makro mehrere Tausend Werte aus, die werden in ein Array geschrieben.
In A2 kommt das Array auf dem Tabellenblatt "Übersicht"
also .Cells(2, 1).Resize(UBound(arrErgebnis, 1), 6) = arrErgebnis
das sind dann zwischen 150 Zeilen und 600 Zeilen auf 6 Spalten
Ich würde es gerne so machen dass 8 oder 10 Datensätze in die Tabelle kommen und die nächsten 10 sollen dann 2 Zeilen unter die ersten 10, ich komm aber einfach auf keine schleife die mir das macht, kennt ihr eine passende?
Es sollen bis zu 50 Datensätze auf das Tabellenblatt "Übersicht" kommen können.
Hier nochmal Code:

With wksErgebnis
.Cells(1, 1).Value = "Nr. Block"
.Cells(1, 2).Value = "Minimum"
.Cells(1, 3).Value = "Mittelwert"
.Cells(1, 4).Value = "StAbw"
.Cells(1, 5).Value = "Zeile 1"
.Cells(1, 6).Value = "Zeile 2"
.Columns(2).NumberFormat = wksData.Cells(2, 1).NumberFormat
.Columns(3).NumberFormat = "#,##0.0;-#,##0.0;0.0;@"
.Columns(4).NumberFormat = "#,##0.0;-#,##0.0;0.0;@"
.Cells(2, 1).Resize(UBound(arrErgebnis, 1), 6) = arrErgebnis
.Columns.AutoFit
End With
Ich hatte es mit ein paar verschiedenen If Schleifen versucht aber die haben nicht das gewünschte erreicht, meine Do Until und For Schleifen gingen gnadenlos daneben

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

Betreff
Datum
Anwender
Anzeige
AW: 10 Datensätze dann wieder runter und wieder 10
09.11.2016 17:21:04
Bastian
Hey Ho
Ohne zu wissen wie dein array aussieht oder wie es gefüllt wird .
Gruß Basti
x = 2
With wksErgebnis
.Cells(1, 1).Value = "Nr. Block"
.Cells(1, 2).Value = "Minimum"
.Cells(1, 3).Value = "Mittelwert"
.Cells(1, 4).Value = "StAbw"
.Cells(1, 5).Value = "Zeile 1"
.Cells(1, 6).Value = "Zeile 2"
.Columns(2).NumberFormat = wksData.Cells(2, 1).NumberFormat
.Columns(3).NumberFormat = "#,##0.0;-#,##0.0;0.0;@"
.Columns(4).NumberFormat = "#,##0.0;-#,##0.0;0.0;@"
For r = LBound(arrErgebnis, 1) To UBound(arrErgebnis, 1)
For c = LBound(arrErgebnis, 2) To UBound(arrErgebnis, 2)
.Cells(x, c) = arrErgebnis(r, c)
Next c
x = x + 1
zähler = zähler + 1
If zähler = 10 Then x = x + 2: zähler = 0
Next r
.Columns.AutoFit
End With
End Sub

Anzeige
10 Datensätze dann wieder runter und wieder 10
09.11.2016 19:39:44
Michael
Hi,
ich habe auch mal damit herumgespielt:
Sub test()
Dim a, z&, o&
Const oAbs = 5 ' effektiver Zeilen-Offset
a = Range("B7:G24")
For z = LBound(a) To UBound(a)
If (z Mod 8) = 0 Then o = o + 1 ' oder + 2 z.B. oder z Mod 10 oder oder...
Range("I1").Resize(, 6).Offset(o + z + oAbs) = Application.Index(a, z, 0)
Next
End Sub

Ist so nicht direkt einsetzbar (die Variablen heißen anders, Bastis Zähler läuft runder usw.), soll aber die Funktionsweise von Application.Index demonstrieren.
Aufgeschnappt habe ich das erst vor ein paar Tagen, und zwar beim Code von snb in ...
https://www.herber.de/cgi-bin/callthread.pl?index=1523162
...was mich denn angeregt hat, diese "fiese" Sache mit dem (dortigen) [row(1:11)] in die vorliegende Aufgabenstellung einzubauen.
Das ist mir in dieser sehr kurzen Schreibweise nicht (direkt) gelungen, nur über den Umweg über evaluate; so oder so wird ein Array mit Zeilennummern erzeugt, was dann insgesamt so aussehen könnte:
Sub test2()
Dim aZ, z&, o&, Sdl&, UBa&  ' UBa=ubound(a), Sdl=Schleifendurchlauf
Dim aSp    ' Array für Spalten
Dim ZpB&, AzB& ' Zeilen pro Block, Abstand zwischen Block, beides as long
ZpB = 8
AzB = 2
z = 1        ' LBound(a) - der Index darf nicht 0 sein!
' aSp = Array(1, 2, 3, 4, 5, 6)
' alternativ auch:
aSp = [rows(1:6)]
UBa = UBound(a)
If LBound(a) = 0 Then UBa = UBa + 1
While z  UBa Then ZpB = UBa - (Sdl - 1) * ZpB
aZ = Evaluate("=row(" & z & ":" & z + ZpB - 1 & ")")
z = z + ZpB
Range("q7").Resize(ZpB, 6).Offset(o) = Application.Index(a, aZ, aSp)
Wend
End Sub

Der Code sieht fürchterlich kompliziert aus, renn aber um einen Faktor 3 schneller als der obere.
Die Zeile
If LBound(a) = 0 Then UBa = UBa + 1
verhindert, daß die für den Index verwendete Variable 0 sein kann; analog sei auf diese Kleinigkeit in Bastis Code hingewiesen: x-mäßig kann ja kein Problem auftreten, aber falls das Array auch spaltenmäßig 0-basiert sein *sollte*, wird .Cells(x, c) bei c=0 mit Fehler abbrechen.
Ich muß mich schon fast entschuldigen: Bastis Variante läuft sicher brav bei den paar Daten! Es hat mich aber interessiert, die kompakte Formulierung von snb zu durchschauen...
Testdatei zum Spielen: https://www.herber.de/bbs/user/109305.xlsm
Schöne Grüße,
Michael
Anzeige
AW: 10 Datensätze dann wieder runter und wieder 10
10.11.2016 09:13:11
Max2
Hallo Michael, danke für den Beitrag,
habe mir erst jetzt die Datei angeschaut, die ist wirklich super, muss leider gestehen dass ich da gar nicht mehr durchblicke und deshalb leider nicht weiß was ich durch meine Variablen etc. ersetzten müsste.
AW: 10 Datensätze dann wieder runter und wieder 10
09.11.2016 21:36:06
snb

Sub M_snb()
sn = Array("Nr. Block", "Minimum", "Mittelwert", "StAbw", "Zeile 1", "Zeile 2")
For j = 1 To 40
Cells(1 + 12 * (j - 1), 1).Resize(, 6) = sn
Next
End Sub

AW: 10 Datensätze dann wieder runter und wieder 10
10.11.2016 09:09:14
Max2
Hallo Basti und natürlich auch Hallo an alle anderen,
danke für eure Hilfe aber ich habe mich etwas unklar ausgedrückt
Ich habe bis zu 50 Tabellenblätter, jedes Tabellenblatt hat zwischen 1600 und 7500 beschriebene Zeilen.
Das hier ist mein Array:

With Application.WorksheetFunction
If .Count(rngBlock) > 0 Then
arrErgebnis(lngZeile_3, 3) = .Average(rngBlock)
arrErgebnis(lngZeile_3, 4) = .StDev(rngBlock)
arrErgebnis(lngZeile_3, 2) = .Min(rngBlock)
End If
End With
With Application.WorksheetFunction
arrErgebnis(lngZeile_3, 5) = lngZeile
arrErgebnis(lngZeile_3, 1) = lngZeile_3
End With
If lngZeile + lngZeilenBlock - 1 > lngZeile_2 Then
arrErgebnis(lngZeile_3, 6) = lngZeile_2
Else
arrErgebnis(lngZeile_3, 6) = lngZeile + lngZeilenBlock - 1
End If
Next lngZeile
End With
rngBlock = 50
Es wird also immer in jedem der bis zu 50 Tabellenblätter ein 50er Block ausgewertet, dann der nächste usw. wenn alle Blöcke ausgerechnet wurden und die Ergebnisse in das Blatt "Übersicht" geschrieben wurden kommt das nächste Tabellenblatt.
Also so zumindest der Plan, bis jetzt Schreibt er mir eben die Auswertung für jedes Blatt in "A:F"
Aber nur die Auswertung des ersten Blattes soll in "A:F" die nächste Auswertung soll dann in "H:M" usw. usw.
Das ganze soll 10 mal passieren, nachdem die Auswertungen für 10 Blätter in Blatt "Übersicht" geschrieben wurden, soll er die letzte Zeile in "Übersicht" finden und die nächsten Zehn Auswertungen 2 Zeilen weiter drunter schreiben.
(Letzte Zeile ermitteln z.B. mit .Cells.SpecialCells(xlCellTypeLast).Row)
Hier Beispiel Mappe, ich glaube dann versteht man es, tut mir leid wenn ich mich nicht klar ausdrücke.

Die Datei https://www.herber.de/bbs/user/109308.xlsx wurde aus Datenschutzgründen gelöscht


Anzeige
10 Datensätze dann wieder runter und wieder 10
10.11.2016 15:32:33
Michael
Hi Max,
falls es keine definitiven Gründe gibt, die Übersicht so zu lassen, würde ich eine geraffte Form vorschlagen: die benötigt deutlich weniger Spalten und ist insofern auch viel einfacher (mit dem Auge) zu erfassen: https://www.herber.de/bbs/user/109323.xlsx
Offensichtlich sind die zu analysierenden Tabellenblätter von unten nach oben mit Werten gefüllt, d.h. mitunter sind die ersten 6000 Zeilen leer: warum nicht gleich nach dem 1. Wert suchen und das Makro ab da aufsetzen? Spart Schleifendurchläufe.
Die ganze Programmierung scheitert jedoch an zwei Dingen:
- wie sollen wir Dir helfen, wenn wir die vorhandenen Makros bzw. die (exakte) Datenstruktur nicht kennen? Wie viele Spalten hat ein auszuwertendes Blatt?
- bis das richtig rund läuft, müßte ich einige weitere Stunden investieren, was meinen Rahmen für einen kostenlosen Forumsbeitrag überschreiten würde.
Falls sich niemand findet, der Dir kostenlos helfen möchte, kannst Du Dich gern an Herrn Herber, einen Kollegen aus den Forums-Profilen oder an mich wenden: https://www.herber.de/cgi-bin/profile/call_profile.pl?user=1857094
Falls doch: umso besser...
Schöne Grüße,
Michael
Anzeige
AW: 10 Datensätze dann wieder runter und wieder 10
10.11.2016 16:02:18
Max2
Hey,
erstmal vielen Dank dass du so viel Zeit in mein Problem investierst/investiert hast.
Der ganze Code ist ziemlich groß, es ist eine UserForm mit vielen Auswahlfeldern und Eingabefeldern und einem Modul.
Es werden CSV-Dateien reingeladen, diese haben zwischen 7500 Zeilen und 100 Spalten bis 30000 Zeilen und 400 Spalten, kann aber je nach Datei eben variieren.
Die Nutzer die diese UserForm verwenden sollen folgendes können:
Per Button einen Ordner auswählen aus dem dann alle CSV-Dateien in einer Combobox angezeigt werden.
Der ausgewählten Datei eine Zahl geben können.
Mehrere CSV Dateien in das gleiche Tabellenblatt reinladen können.
Einen Zellbereich festlegen können wo die Werte aus der CSV-Datei eingefügt werden(diese Angabe in Meter oder Millimeter, also In Tabblatt1 die erste Datei ab Meter 3 die zweite Datei ab Meter 1,80 usw.).
Dann sollen sie die spuren/tabellenblätter weiter bearbeiten können.
Also alle Tabellenblätter kommen in eine Combobox.
Blatt auswählen Bereich angeben in dem Werte ersetzt/eingefärbt/oder gelöscht werden und dann ausführen
(Man kann auswählen ob Werte >, Wenn das Blatt "Übersicht" ausgewählt wird darf dass ersetzten, einfärben, löschen nur in bestimmten bereichen passieren
Alles in allem also ein Makro/Userform mit haufenweise Nutzer definierten Variablen und Werten
Hier ist übrigens der Code den ich geschrieben habe für die 10 Datensätze dann runter und wieder 10, funktioniert einwandfrei, ist allerdings nicht besonders schön...

With wksErgebnis
x = 1
y = 2
z = 1
If UserForm1.OptionButton1 = True Then
r = 152
ElseIf UserForm1.OptionButton2 = True Then
r = 302
ElseIf UserForm1.OptionButton3 = True Then
r = 602
End If
If .Cells(y, x).Value = "" Then
.Cells(z, x).Value = wksData.Name
.Cells(y, x).Resize(UBound(arrErgebnis, 1), 6) = arrErgebnis
ElseIf .Cells(y, x).Value  "" Then
c = .Cells(y, Columns.Count).End(xlToLeft).Column
x = c + 3
If x > 80 Then
If .Cells(600, 2).Value  "" Then
r = r * 3
ElseIf .Cells(300, 2).Value  "" Then
r = r * 2
ElseIf .Cells(150, 2).Value  "" Then
r = r
End If
y = 2 + r
x = 1
If .Cells(y, x).Value  "" Then
c = .Cells(y, Columns.Count).End(xlToLeft).Column
x = c + 3
End If
End If
.Cells(y, x).Resize(UBound(arrErgebnis, 1), 6) = arrErgebnis
End If
End With

Anzeige

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige