如何使用vba将多个长行拆分为excel中的较小行？

Question

我在一行中有大约30列数据,我想分成多行,这样每行有7列,但我希望结果在另一张表上.例如:

1   2   3   4   5   6   7   8   9   10  11  12  13  14  15  16  17  18  19  20
mon tue wen thu fri sat sun mon tue wen thu fri sat sun mon tue wen thu fri sat...
sun mon tue wen thu fri sat sun mon tue wen thu fri sat sun mon tue wen thu fri ...
sat mon tue wen thu fri sat sun mon tue wen thu fri sat sun mon tue wen thu fri sun mon...

我希望它看起来像:

1   2   3   4   5   6   7
mon tue wen thu fri sat sun
8   9   10  11  12  13  14
mon tue wen thu fri sat sun
15  16  17  18  19  20
mon tue wen thu fri sat
                        1
                        sun
2   3   4   5   6   7   8
mon tue wen thu fri sat sun
9   10  11  12  13  14  15
mon tue wen thu fri sat sun
16  17  18  19  20
mon tue wen thu fri
                    1   2
                    sat sun
3   4   5   6   7   8   9
mon tue wen thu fri sat sun
10  11  12  13  14  15  16
mon tue wen thu fri sat sun
17  18  19  20  21  22  23
mon tue wen thu fri sat sun
24
mon

我尝试将我发现的一些代码调整到我的问题中,但它们都只是一行数据的答案.例如,我找到了代码:

Public Sub SplitRows()

Dim rowRange As Variant
Dim colCount As Integer
Dim lastColumn As Long
Dim rowCount As Integer
rowCount = Cells(Rows.Count, "A").End(xlUp).Row
Dim ws As Worksheet
Set ws = Sheets("Sheet1")

Dim i As Integer
i = 1
Do While (i < rowCount)
lastColumn = ws.Cells(i, Columns.Count).End(xlToLeft).Column
colCount = ws.UsedRange.Columns.Count
rowRange = Range(Cells(i, 2), Cells(i, colCount))
If Not lastColumn <= 7 Then
    Dim x As Integer
    For x = 2 To colCount - 1
        If Not IsEmpty(rowRange(1, x - 1)) And (x Mod 7) = 1 Then
            Cells(i, 1).Offset(1).EntireRow.Insert
            rowCount = rowCount + 1     
            ws.Cells(i + 1, 1).Value = ws.Cells(i, 1).Value
            Dim colsLeft As Integer
            For colsLeft = x To colCount - 1

                ws.Cells(i + 1, colsLeft - 7).Value = rowRange(1, colsLeft)
                ws.Cells(i, colsLeft + 1).Value = ""    
            Next
        Exit For            
      End If
    Next
End If
i = i + 1
Loop
End Sub

但它仅适用于第一行(数字).

Answer 1

当使用正确的函数和方法应用简单数学就足够时,不要构建嵌套循环和conitional if语句的迷宫.

Sub calendarYear()
    Dim yr As Long, dy As Long
    Dim r As Long, c As Long

    yr = 2018

    With Worksheets("sheet2")
        For dy = DateSerial(yr, 1, 1) To DateSerial(yr, 12, 31)
            r = r - CBool(Month(dy) <> Month(dy - 1)) - CBool(Weekday(dy, vbMonday) = 1)
            c = Weekday(dy, vbMonday)
            .Cells(r, c) = Format(dy, "d" & Chr(10) & "ddd")
        Next dy
    End With
End Sub