查找行范围是否有连续月份的解决方案 - 添加缺少月份的行答案

【问题标题】：Solution for finding if range of rows have consequtive months- add a row with missing month查找行范围是否有连续月份的解决方案 - 添加缺少月份的行
【发布时间】：2020-05-10 16:35:10
【问题描述】：

我希望能够检查行范围是否有连续的月份，如果缺少任何月份，请添加缺少月份的行（月份/2020 年 1 月的格式有效）。如下图所示，二月不见了。我假设我可以使用与 if 语句混合的 while 循环，但不确定如何为其编写 VBA 代码。请指教。谢谢！

【问题讨论】：

如果你尝试，那就是寻求帮助。如果你不这样做，那就是为你做这项工作的请求。
你有VBA的经验吗？

标签： excel vba

【解决方案1】：

也许是这样的：

从上面的示例中，插入的行将是：
1. G2 上方 2 行，其值为 8 月和 9 月
2. G5 上方 2 行，值为 Jan 和 Feb
3. G10上方1行，值为Aug
4. G14上方1行，值为Jan
以此类推。

所以，结果是这样的：

代码是：

Sub test()
Set rng1 = Range("G1") 'change if needed
Set rng2 = rng1.Offset(1, 0)

Do
CellMonth = Format(rng1, "m") 'the month in the "current" cell
If CellMonth <> "12" Then 'if the month in the "current" cell is not 12
CheckMonth = Format(DateAdd("m", 1, rng1), "m") 'then check month is the next month
Else
CheckMonth = "1" 'else, check month is 1
End If
NextCellMonth = Format(rng2, "m") 'the month in the next row

If NextCellMonth <> CheckMonth Then 'if the month in the next row is not the next month of "current" cell
n = NextCellMonth - CheckMonth 'get the discrepancy
For i = 1 To n 'loop as many as the discrepancy value
rng2.EntireRow.Insert 'insert entire row
oFill = Format(DateAdd("m", 1, rng1), "m") & "/01/20" 'prepare the value for the newly created row
rng2.Offset(-1, 0).Value = oFill 'fill the newly created value
'rng2.Offset(-1, 0).Interior.Color = vbYellow
Set rng1 = rng1.Offset(1, 0)
Set rng2 = rng1.Offset(1, 0)
Next i
End If

Set rng1 = rng1.Offset(1, 0)
Set rng2 = rng1.Offset(1, 0)
Loop Until rng2.Value = ""
End Sub

新创建行的日期和年份值始终为第 1 天和 2020 年。
如果我没记错的话就明白你的意思了。

【讨论】：