求助。。。VBA根据所填的值返回开始和结束的日期

ccwang

	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31
赵四	0.5	1	1							1	1					0.5					0.5	1
李三					0.5	1	1												1	1
等等									1	1	1	1												1	1	1

各位大神， 我现在有一个这样的表格，然后根据他们填的信息返回开始的日期以及结束的日期，比如现在是6月，那希望可以生成下面的数据：

	开始	结束
赵四	1-Jun-19	3-Jun-19
赵四	10-Jun-19	11-Jun-19
赵四	16-Jun-19	16-Jun-19
赵四	21-Jun-19	22-Jun-19
李三	5-Jun-19	7-Jun-19
李三	19-Jun-19	20-Jun-19
等等	9-Jun-19	12-Jun-19
等等	24-Jun-19	26-Jun-19

实在是想不出该怎么写了，请教一下论坛的大神们。。。谢谢！

hfwufanhf2006

运行代码之前，把你下面手工填上去的范例数据先删掉，我需要有地方存放运行结果。
我认为你的数据不是很规范，所以我就把两个重要的参数放在最前面，你自己改：
1、生成结果存放首行 hs，我设定为第10行；
2、当前年月 ri ，我设定为 “2019/06/"，因为你说假定是6月份；

hs = 10
ri = "2019/06/"
For i = 2 To 10000
    If IsEmpty(Cells(i, 1)) Then
       Exit For
    End If
    bz1 = False
    For k = 2 To 33
        If (Not IsEmpty(Cells(i, k))) And (Not bz1) Then
           s1 = CDate(ri & Cells(1, k))
           bz1 = True
        End If
        If (IsEmpty(Cells(i, k))) And bz1 Then
           s2 = CDate(ri & Cells(1, k - 1))
           bz1 = False
           Cells(hs, 1) = Cells(i, 1)
           Cells(hs, 2) = s1
           Cells(hs, 3) = s2
           hs = hs + 1
        End If
    Next k
Next i

ccwang

hfwufanhf2006 发表于 2019-6-3 10:48
运行代码之前，把你下面手工填上去的范例数据先删掉，我需要有地方存放运行结果。
我认为你的数据不是很规 ...

受教了！谢谢！！