Auheben einer Spalte mit 35040 Zeilen

Ich habe ViertelStunden Werte von einem Jahr in einer Spalte mit entsprechendem Datum... Das sind Ökostromeinspeisemenegen, welche viertelstündlich sich verändern... Also gibt es eine Spalte mit 4(viertelstunden)x24(stunden)x365(Tage)=35040 zeilen.
Nun will ich die Spalte einmal in Wochen, Monate und Quartalsweise aufteilen, so dass sie danach spaltenweise angezeigt werden...
davor
01.01.07 00:00
....
01.01.07 23:15
...
31.12.07 23:15
35040 zeilen geht es nach unten
Nun soll es so aufgeteilt werden
Woche
48 Spalten für jede woche mit 24 (h) x 4(viertelstunden) * 7 (woche)= 672 zeilen
Woche1 Woche2 Woche3
672 Zeilen nach unten
Monat
12 Spalten für jeden Monat mit 24 (h) x 4(viertelstunden) * 7 (woche) * 4(Monat)= 2688 zeilen
Monat1 Monat2 Monat3
Ganz wichtig ist, dass sich der Monat nicht nach dem Datum orientiert, sondern 4 wochen sind ein Monat und ein Quartal sind 12 wochen
Ich danke im voraus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Servus Thomas,


Sub Unterteilung()
Application.ScreenUpdating = False
Dim letzteE As Long
letzteE = Range("E65536").End(xlUp).Row
Range("E1:BS" & letzteE).ClearContents ' Löschen vorhandener Einträge
Dim letzteA As Long
If Range("A65536")  "" Then
letzteA = 65536
Else
letzteA = Range("A65536").End(xlUp).Row ' letzte in A ermitteln
End If
Dim zeile As Long
Dim zähler As Double
zähler = 0
For zeile = 1 To 35040 Step 672 ' Wochen schreiben
Range(Cells(zeile, 3), Cells(zeile + 671, 3)).Copy Cells(2, 5 + zähler)
zähler = zähler + 1
Next zeile
Dim spalte As Long
Dim zähler1 As Double
zähler1 = 0
For spalte = 5 To 56 Step 4 ' Monate schreiben
Range(Cells(2, spalte), Cells(673, spalte)).Copy Cells(2, 58 + zähler1)
Range(Cells(2, spalte + 1), Cells(673, spalte + 1)).Copy Cells(65536, 58 + zähler1).End(xlUp). _
Offset(1, 0)
Range(Cells(2, spalte + 2), Cells(673, spalte + 2)).Copy Cells(65536, 58 + zähler1).End(xlUp). _
Offset(1, 0)
Range(Cells(2, spalte + 3), Cells(673, spalte + 3)).Copy Cells(65536, 58 + zähler1).End(xlUp). _
Offset(1, 0)
zähler1 = zähler1 + 1
Next spalte
Dim letzteSpalteZeile As Long
letzteSpalteZeile = Range("BE65536").End(xlUp).Row
Range("BE2:BE" & letzteSpalteZeile).Copy Range("BS2") ' letzte spalte = nicht komplette Woche  _
als Moant kopieren
Dim spalteWoche As Long
For spalteWoche = 5 To 57
Cells(1, spalteWoche) = "KW " & spalteWoche - 4 ' Überschriften Woche
Next spalteWoche
Dim spalteMonat As Long
For spalteMonat = 58 To 71
Cells(1, spalteMonat) = "Monat " & spalteMonat - 57 ' Überschriften Monat
Next spalteMonat
Application.ScreenUpdating = True
End Sub

et voila.
Die Wochen und Monate werden nach rechts nebeneinander geschrieben, erst Wochen, dann Monate (immer alle Werte aus spalte C) und ancshließend mit den passenden Überschriften versehen.
Du kannst das makro öfters ausführen, da vor Schreiben der Monate, der gefüllte Bereich der KW und Monate zuerst geöscht wird.
Gruß
Chaos

Beliebteste Forumthreads (12 Monate)

Auheben einer Spalte mit 35040 Zeilen

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread