Разделение данных одного столбца на несколько столбцов в зависимости от високосного года в Excel 2013

Question

У меня есть около 100 файлов MS Excel, которые состоят из данных о погоде.

Мне нужны данные на ежегодной основе, но файл содержит один столбец с данными о 140 годах, и копирование-вставка вручную занимает очень много времени. Итак, есть ли способ разделить данные с помощью простых команд, которые можно перетаскивать, чтобы данные за 1 год (365 ячеек) копировались в непрерывные строки.

Кроме того, существует проблема високосного года, что данные каждые 3 года должны составлять 366 ячеек вместо остальных 365 ячеек.

Answer 1

Поскольку вы не можете заставить работать другой макрос по этому вопросу, я решил, что поработаю с неопровержимыми фактами, которые вы представили здесь, и облегчит вам задачу.

Для вашего конкретного диапазона дат этот макрос будет работать -

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

Answer 2

Попробуйте этот макрос

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

Довольно бесполезный снимок экрана:

Пожалуйста, попробуйте на копии ваших данных ... Я не несу ответственности за нарушение всего. Вам также нужно будет проверить его правильно и убедиться, что все данные присутствуют, но я думаю, что все в порядке.