Dividir dados de coluna única em várias colunas com base no ano bissexto no Excel 2013

Question

Eu tenho cerca de 100 arquivos do MS Excel, que consistem em dados meteorológicos.

Eu preciso dos dados anualmente, mas o arquivo tem uma única coluna com dados de cerca de 140 anos e copiar e colar manualmente é muito demorado. Então, existe alguma maneira de dividir os dados usando comandos simples que podem ser arrastados para que os dados de 1 ano (365 células) sejam copiados em linhas contínuas.

Além disso, há o problema do ano bissexto de que os dados a cada 3 anos devem ser 366 células em vez das restantes 365 células.

    

Answer 1

Como você não consegue fazer a outra macro funcionar por essa pergunta , achei que trabalharia com os fatos que você apresentou aqui e facilite para você.

Para o seu período específico, esta macro funcionará -

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

Experimente esta macro

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

Captura de tela bastante inútil:

Por favor, tente em uma cópia dos seus dados ... Eu não sou responsável por quebrar tudo. Você também precisará testá-lo adequadamente e garantir que todos os dados estejam presentes, mas acho que está tudo bem.