怎么通过VBA来自动生成年度的周数及每周对应的时间段

LDH_79687

各位好：怎么用VBA来自动生成年度的周数及每周对应的时间段。

怎么通过在B1处输入的年份，自动生成该年度的周数及每周对应的时间段。

例如：当输入2019时，week1是2018/12/31-2019/1/6；

maditate

问题的关键第一周从那天算起。比如1月1日是星期三，第一周是从1月1日到5日，还是从5日开始算？有了基本的规定，后面的问题应该不难办。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     nf = .Range("b1")
   
6.     rq = DateSerial(nf, 1, 1)
   
7.     Do Until Weekday(rq, 2) = 1
   
8.       rq = rq - 1
   
9.     Loop
   
10.     ReDim arr(1 To 55, 1 To 2)
    
11.     m = 0
    
12.     Do
    
13.       m = m + 1
    
14.       arr(m, 1) = "week" & m
    
15.       arr(m, 2) = rq & "-" & rq + 6
    
16.       rq = rq + 7
    
17.     Loop Until rq >= DateSerial(nf, 12, 31)
    
18.     .Range("a3").Resize(m, 2) = arr
    
19.   End With
    
20. End Sub
    

复制代码

LDH_79687

maditate 发表于 2019-7-26 14:49
问题的关键第一周从那天算起。比如1月1日是星期三，第一周是从1月1日到5日，还是从5日开始算？有了基本的规 ...

每年的第一天是包含在第一周中，不管1月1日是星期几，都计算在第一周，以7天为一周，当每年的1月1日不是周一的时候，在时间段中起始时间中取上一年度12月的最后一周作为本年度的第一周。

chxw68

详见附件。

LDH_79687

chxw68 发表于 2019-7-26 14:57
详见附件。

醍醐灌顶！！不愧是是大神，谢谢！

LDH_79687

chxw68 发表于 2019-7-26 14:57
详见附件。

您好，不好意思，能再加个判断吗？就是当时间段有跨度到下一月的时候，在A1单元格生成本月累计，比如1月累计或者2月累计，详见下图，谢谢！

chxw68

LDH_79687 发表于 2019-7-26 15:33
您好，不好意思，能再加个判断吗？就是当时间段有跨度到下一月的时候，在A1单元格生成本月累计，比如1月 ...

除润年2月是29天，其他年份每月天数是固定的

chxw68

修改好了。

LDH_79687

chxw68 发表于 2019-7-26 16:03
修改好了。

您好：累计前后的week序号不对了，如下图