新人小白正在学习vba，求指教。以日期分类，同一天有一行数据就在数据末尾插入35空行

mao9998

新人小白正在学习vba，求指教，以日期列分类，同一天有一行数据就在数据末尾插入35空行，同一天有两行就在数据末尾插入34空行，有三行数据就在数据末尾插入33空行，以此类推。保证下一个37行开始是新一天的数据。Sheet2为例子

mao9998

学习数据.rar (44.9 KB, 下载次数: 15)

2024-1-9 15:31 上传

点击文件名下载附件
学习数据

咔咔乱坠

365函数，凑个热闹

1. =VSTACK(A1:H1,LET(_row,36,_seq,Sheet1!A2:A343,DROP(REDUCE(0,UNIQUE(_seq),LAMBDA(x,y,VSTACK(x,LET(_data,FILTER(Sheet1!A2:H343,_seq=y),DROP(REDUCE(0,SEQUENCE(ROUNDUP(ROWS(_data)/_row,))*_row,LAMBDA(a,b,VSTACK(a,EXPAND(DROP(TAKE(_data,b),b-_row),_row,,"")))),1))))),1)))

复制代码

shinechou86

运行的有点慢，不过貌似可以实现。

mao9998

咔咔乱坠 发表于 2024-1-9 15:55
365函数，凑个热闹

谢谢 感谢大神支持

mao9998

shinechou86 发表于 2024-1-9 18:08
运行的有点慢，不过貌似可以实现。

太感谢了  我学习一下 感谢支持

mao9998

咔咔乱坠 发表于 2024-1-9 15:55
365函数，凑个热闹

大神，函数已经收到了，但是不会用，修改和编辑都显示错误。。。。。

wengjl

Sub ss()
    js = 0
    rq = Sheet1.Cells(2, 1).Value
    x1 = 2
    Do While Not (IsEmpty(Sheet1.Cells(x1, 1).Value))
      If Sheet1.Cells(x1, 1).Value = rq Then
        js = js + 1               ' 对相同的日期进行检测并计数
      Else
        For i = 1 To 36 - js      ' 根据日期个数，插入行数
          Cells(x1, 1).Select
          Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
        Next i
        x1 = x1 + 36 - js                  ' 跳过空行，以便保证对下一个日期的检测
        rq = Sheet1.Cells(x1, 1).Value     ' 保存下一个日期，以便判断
        js = 1                             ' 初始化计数变量
      End If
      x1 = x1 + 1
    Loop
End Sub

调试通过的

咔咔乱坠

mao9998 发表于 2024-1-12 09:30
大神，函数已经收到了，但是不会用，修改和编辑都显示错误。。。。。

excel365版本的函数，版本太低没法用哦

mao9998

wengjl 发表于 2024-1-12 10:29
Sub ss()
    js = 0
    rq = Sheet1.Cells(2, 1).Value

谢谢大神  已可以用。