按日期转换表格数据

ynbslyq

求助：需要把表格数据由多列按日期转成4列，左边逐日表数据，按日期转换成右边四列格式。因有多年数据，量很大，需要用VBA代码实现。请高手帮助解决！谢谢

yynrzwh

按日期转换数据.rar (37.67 KB, 下载次数: 8)

2024-1-31 17:29 上传

点击文件名下载附件

feilanga

排除空值。。。。。。。。。。

feilanga

ynbslyq

yynrzwh 发表于 2024-1-31 17:29

非常感谢！！！

ykcbf1100

附件供参考。。。

ynbslyq

feilanga 发表于 2024-1-31 17:44
排除空值。。。。。。。。。。

非常感谢！！！

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.31
   
2.     mc = Split(Me.[a1])(0)
   
3.     nf = Val(Split(Me.[a2], ":")(1))
   
4.     bm = Me.[d2]
   
5.     r = Me.Cells(Rows.Count, 1).End(3).Row
   
6.     arr = Me.Range("a1:m" & r)
   
7.     ReDim brr(1 To 10000, 1 To 4)
   
8.     On Error Resume Next
   
9.     For j = 2 To UBound(arr, 2)
   
10.         For i = 5 To UBound(arr)
    
11.             If arr(i, 1) <> Empty Then
    
12.                 rq = CDate(DateSerial(nf, j - 1, arr(i, 1)))
    
13.                 m = m + 1
    
14.                 brr(m, 1) = mc
    
15.                 brr(m, 2) = bm
    
16.                 brr(m, 3) = rq
    
17.                 brr(m, 4) = arr(i, j)
    
18.             End If
    
19.         Next
    
20.     Next
    
21.     Me.[s4:v10000] = ""
    
22.     Me.[s4].Resize(m, 4) = brr
    
23.     MsgBox "OK！"
    
24. End Sub
    

复制代码

ynbslyq

ykcbf1100 发表于 2024-1-31 17:55
附件供参考。。。

太感谢啦！！！那么多高手。

cjc209

就是一个双循环加判断有什么难?