Teilen Sie einzelne Spaltendaten basierend auf dem Schaltjahr in Excel 2013 in mehrere Spalten auf

Ich habe ungefähr 100 Dateien von MS Excel, die aus Wetterdaten bestehen.

Ich benötige die Daten auf Jahresbasis, aber die Datei hat eine einzige Spalte mit Daten von ungefähr 140 Jahren und das manuelle Kopieren und Einfügen ist sehr zeitaufwendig. Gibt es also eine Möglichkeit, die Daten mithilfe einfacher Befehle zu teilen, die gezogen werden können, sodass Daten von 1 Jahr (365 Zellen) in fortlaufenden Zeilen kopiert werden.

Außerdem gibt es das Schaltjahrproblem, dass die Daten nach 3 Jahren 366 Zellen anstelle der restlichen 365 Zellen sein sollten.

Da das andere Makro bei dieser Frage scheinbar nicht funktioniert , habe ich mir vorgenommen, dass ich mit den harten Fakten, die Sie hier vorgestellt haben, arbeite und es Ihnen einfach mache.

Für Ihren spezifischen Datumsbereich funktioniert dieses Makro:

Sub test()
'fill dates
Application.ScreenUpdating = False
Dim NumCells As Integer
NumCells = [counta(A:A)]
Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Cells(1, 1) = "1/1/61"
Range(Cells(1, 1), Cells(NumCells, 1)).DataSeries

'move data
Dim c As Range
Dim cCol As Integer
cCol = 4
label:
For Each c In Range("A:A")
If c.Value = "" Then Exit Sub

    For i = 1 To 366
        If Not Right(c, 4) = Right(c.Offset(i), 4) Then
         GoTo label2
        End If
    Next
label2:
        Range(c, c.Offset(i - 1, 1)).Copy
        Cells(1, cCol).PasteSpecial Paste:=xlPasteValues
        Range(c, c.Offset(i - 1, 1)).Delete xlShiftUp
        Range(Cells(1, cCol), Cells(366, cCol)).NumberFormat = "mm/dd/yyyy"
        cCol = cCol + 3
        GoTo label

Next
Application.ScreenUpdating = True
End Sub

Probieren Sie dieses Makro aus

Sub Button1_Click()

Dim row As Integer
row = 1

Dim otherRow As Integer
otherRow = 1

Dim year As Integer
year = 1

Dim column As Integer
column = 66 ' start on B

Dim preColumn As Integer
preColumn = 64

Do While (True)

If Range("A" & row).Value = "" Then
    Exit Do
End If

If (column > 90) Then
    preColumn = preColumn + 1
    column = 65
End If


If (preColumn = 64) Then

Range(Chr(column) & otherRow).Value = Range("A" & row).Value

Else

Range(Chr(preColumn) & Chr(column) & otherRow).Value = Range("A" & row).Value

End If


Dim addition As Integer
addition = 0

If (year = 4) Then
    addition = 1
End If

If (otherRow = 365 + addition) Then
column = column + 1
otherRow = 0

year = year + 1

End If


If (year > 4) Then
 year = 1
End If

row = row + 1
otherRow = otherRow + 1

Loop

End Sub

Ziemlich nutzloser Screenshot davon, wie es funktioniert:

Bitte versuchen Sie es mit einer Kopie Ihrer Daten ... Ich bin nicht dafür verantwortlich, dass alles kaputt geht. Sie müssen es auch richtig testen und sicherstellen, dass alle Daten vorhanden sind, aber ich denke, es ist in Ordnung.