Dynamischer Zellbezug

Forumthread: Dynamischer Zellbezug

10.09.2016 10:58:01

Max

Hallo Leute,
zuerst mal zur Datei:
Die Zeilen Anzahl kann zwischen 100 und 30.000 variieren, die Spalten von 1 bis 100.
Mein Problem:
Ich versuche ein Makro zu erstellen welches einen Zell Bereich nimmt und dann den Min-Wert, den Mittelwert und die Standard Abweichung berechnet.
Der zu berechnende Zellbereich soll dabei immer 5 Zeilen und X-Spalten umfassen, anschließend soll der dann die nächsten 5 Zeilen berechnen.
Bis jetzt habe ich versucht den Zellbezug zu erstellen in dem ich zur letzten Spalte und zur letzten Zeile gehe, also so:
lngZeile = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
lngSpalte = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
Mit diesen beiden Werten wollte ich dann eine Range festlegen.
Sprich: Geh zur letzten Zeile nehme die 4 vorherigen Zeilen hinzu und dass für alle vorhandenen Spalten. Dann gehe immer 5 Zeilen weiter hoch usw.
Ich dachte Anfangs dass ich das ohne Probleme schaff aber... naja ich verzweifel bei der Range, ich bekomms einfach nicht hin 5 Zeilen und X-Spalten als Range Festzulegen und dann immer 5 Zeilen Hoch zu gehen.
Meine Fehlgeschlagenen Codes kann ich euch leider nicht Zeigen da diese auf meinem Rechner in der Arbeit liegen, Sorry dafür :/
Hat jemand nie Idee wie ich dass realisieren könnte ?

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Ein Versuch

10.09.2016 12:18:26

Fennek
AW: Dynamischer Zellbezug

10.09.2016 12:46:53

fcs
AW: Dynamischer Zellbezug

10.09.2016 16:39:56

Max

AW: Ein Versuch

10.09.2016 12:18:26

Fennek

Hallo,
wie wäre es mit (ungeprüft)


sub test()
for i = 2 to lngZeile step 5'mit header, sonst ab 1
M = worksheetfunction.average(range(cells(i, 1), cells(i+4, lngSpalte))
debug.print i, M
next i
end sub

mfg

AW: Dynamischer Zellbezug

10.09.2016 12:46:53

fcs

Hallo Max,
das kann man z.B. wie folgt lösen.
Zusätzlich müssen die Ergebnisse ja auch noch irgendwie in ein Ergebnisblatt übertragen werden.

Sub aaTest()
Dim Zeile As Long, Zeile_L As Long
Dim ZeilenBlock As Long
Dim AnzSpa As Long
Dim wksData As Worksheet
Dim rngBlock As Range
Dim wksErgebnis As Worksheet
Dim Zeile_E As Long
Dim arrErgebnis()
Set wksData = ActiveSheet
With wksData
'letzte Zeile im benutzen Bereich
Zeile_L = .Cells.SpecialCells(xlCellTypeLastCell).Row
'letzte Spalte im benutzen Bereich
AnzSpa = .Cells.SpecialCells(xlCellTypeLastCell).Column
'alternativ
'letzte Zeile mit Daten
Zeile_L = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'letzte Spalte mit Daten
AnzSpa = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
'Zeilen pro Block
ZeilenBlock = 5
'Daten-Array für Ergebnisse dimensionieren
ReDim arrErgebnis(1 To CLng(Zeile_L / ZeilenBlock) + 1, 1 To 6)
Zeile_E = 0
'Datenblöcke abarbeiten und Ergebnisse ins Daten-Array schreiben
For Zeile = 1 To Zeile_L Step ZeilenBlock
Set rngBlock = .Range(.Cells(Zeile, 1), .Cells(Zeile + ZeilenBlock - 1, AnzSpa))
Zeile_E = Zeile_E + 1
With Application.WorksheetFunction
arrErgebnis(Zeile_E, 1) = Zeile_E
arrErgebnis(Zeile_E, 2) = .Min(rngBlock)
arrErgebnis(Zeile_E, 3) = .Average(rngBlock)
arrErgebnis(Zeile_E, 4) = .StDev(rngBlock)
arrErgebnis(Zeile_E, 5) = Zeile
If Zeile + ZeilenBlock - 1 > Zeile_L Then
arrErgebnis(Zeile_E, 6) = Zeile_L
Else
arrErgebnis(Zeile_E, 6) = Zeile + ZeilenBlock - 1
End If
End With
Next Zeile
End With
'Ergebnisblatt vorbereiten und Daten einfügen
ActiveWorkbook.Worksheets.Add After:=wksData
Set wksErgebnis = ActiveSheet
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
'Fenster fixieren
Range("A2").Select
ActiveWindow.FreezePanes = True
'Variablen aufräumen
Erase arrErgebnis
Set wksData = Nothing: Set wksErgebnis = Nothing: Set rngBlock = Nothing
End Sub

AW: Dynamischer Zellbezug

10.09.2016 16:39:56

Max

Vielen Dank ich werde am Montag gleich beides mal ausprobieren :)

Beliebteste Forumthreads (12 Monate)

Forumthread: Dynamischer Zellbezug

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread