10 Datensätze dann wieder runter und wieder 10

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

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

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

Beliebteste Forumthreads (12 Monate)

10 Datensätze dann wieder runter und wieder 10

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10 Datensätze dann wieder runter und wieder 10

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

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread