查找行范围是否具有相应月份的解决方案-添加缺少月份的行

问题描述 投票:0回答:1

我希望能够检查行范围是否具有连续的月份,以及是否缺少任何行,并添加一个缺少月份的行(Month / 1/2020作品的格式)。如下面的图片所示,缺少2月。我假设我可以将while循环与if语句混合使用,但不确定如何为它编写VBA代码。请指教。谢谢!

enter image description here

excel vba
1个回答
0
投票

也许像这样:

enter image description here

在上面的示例中,插入的行将为:1. G2上方的2行,其中值为Aug和Sep2. G5上方的2行,其值为Jan和Feb3. G10上方的1行,其中值为Aug4. G14上方的1行,其中值为Jan5. G16上方的1行,其中值为May]

所以,结果是这样的:enter image description here

代码是:

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年。如果我没有记错的话,那就可以了。

© www.soinside.com 2019 - 2024. All rights reserved.