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

如何使用vba在excel中将多个长行拆分为较小的行?,vba,excel,Vba,Excel,一行中有大约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 t

一行中有大约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
公共子拆分行()
变光范围
Dim colCount为整数
将最后一列变长
将行计数设置为整数
rowCount=单元格(Rows.Count,“A”).End(xlUp).Row
将ws设置为工作表
设置ws=图纸(“图纸1”)
作为整数的Dim i
i=1
执行时(i如果不是lastColumn当简单的数学应用正确的函数和方法就足够时,不要构建一个嵌套循环和循环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
子日历年()
朦胧的你一样长,朦胧的你一样长
变暗r为长,c为长
yr=2018年
带工作表(“表2”)
对于dy=日期序列(yr,1,1)到日期序列(yr,12,31)
r=r-CBool(月(dy)月(dy-1))-CBool(工作日(dy,vb星期一)=1)
c=工作日(星期一,星期二)
.单元格(r,c)=格式(dy,“d”和Chr(10)和“ddd”)
下一个dy
以
端接头


一定有一些你没有分享的背景。。。这是家庭作业还是什么?因为30列变成7列是“没什么”。手动操作会比你发布问题花费更少的时间…@ashleedawg我有一张12个月的工作表,一个月的所有日子都是连续的。这是一种家庭作业,我必须使用vba,不能手动操作。(哦,是你,更多的家庭作业,嗯?!)那么fsheet是12行长x 30宽之类的东西?您可以使用一对嵌套的
Do..,而
循环。“数到7,换行,重复”并在达到30时退出do。然后再做一次
While
,每个月重复一次。@ashleedawg(是的,又是我)它有25行长,30-31行宽,取决于月份。我想我可以处理这些事情,但困扰我的是,如果前一天的最后一天在第四列,如何将一个月的第一天放在第五列。有一个运行计数器,直到它达到7时才会重置。另一种快速实现的方法是VBA正则表达式。这几乎就是我需要的,你能给我解释一下代码吗,这样我就可以修改它了?因为我已经在工作表上有了需要转换成这种格式的月份天数的单元格。出于所有目的,有五行操作代码。什么需要解释几分钟的google fu无法更快更好地解释?@EnnaSmile
yr=2018
是此过程中使用的年份数,您可以将其替换为
yr=year(Date)
以获取当前年份数。返回指定年、月和日的日期。因此,基本上,他是在特定的一年中每天循环
r
c
分别是单元格的行数和列数。@ennamile
c
由返回日期对应的星期几的函数计算。默认情况下,日期以整数形式给出,范围为1(星期日)到7(星期六)<代码>r
有点诡计。首先,将值转换为布尔值,与诸如
Month(dy)Month(dy-1)
(当前日期的月份不等于前一天的月份)之类的条件一起使用,当Visual Basic将值转换为数字类型时,如在Jeeped的行
r=r-CBool(Month)中,将返回
False
True
@EnnaSmile(dy)月(dy-1))-CBool(工作日(dy,vbMonday)=1)
False
变为
0
True
变为
-1
。例如,对于
01.01.2018
r
将等于
2
,因为
r
在子项开始时是
0
,因此
r=0-False-False
等于
r-/1
r=0+1+1
。希望能有所帮助。