如何获取一个月的第一个实例并添加新行（包括屏幕截图）

Question

请看下面我的 Excel 电子表格的图片。

我想要完成的是在每个连续的月份仅第一个实例顶部添加 3 个空白行。因此，如果新的月份从 2 月开始（或基本上是“2”），则将自动在其顶部添加 3 个空白行。我正在尝试使用 VBA 代码来做到这一点。但是，我的问题在于某些函数如何处理数字和日期（尤其是）与文本/字符串不同。

我当前的 VBA 代码 Sub insert()（显示在我的图像文件下）在单元格 A2 上使用了 LEFT() 函数，但它没有返回我想要的值，即“1”或“01”（代表数字其月份的值）。相反，它返回其实际值“44200”等 - 不是我想要的。我需要找到一种方法，通过在每个新月的顶部插入 3 个空白行来让我的 VBA 代码完成其工作。但它不能用 LEFT() 函数做到这一点。 MONTH() 函数在该代码中也不起作用。我该如何解决这个问题并更改此代码以使其正常工作？感谢您的帮助。

Sub insert()

Dim lastRow As Long
Dim done As Boolean

'change A to the longest column (most rows)
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
    'change the 1 below to the necessary column (ie, use 4 for column D)
    If Left(Cells(i, 1), 2) = "01" Then
    Rows(i).insert
    done = True
    i = i + 1
    End If
    If done = True Then Exit For
Next

End Sub

Answer 1

按月变化插入行

• 在 A 列的单元格中的每个月份更改时，它将在单元格上方插入 3 行。
• 它从上到下循环并将关键单元格（或它们旁边的单元格）组合成一个范围：首先是当前单元格，然后是先前组合的单元格。它在单元格和它们旁边的单元格之间交替，以不获取多个单元格的范围（GetCombinedRangeReverse 中的Application.Union：Union([A1], [A2]) = [A1:A2]，而Union ([A1], [B2]) = [A1,B2]）。
• 最后，它循环遍历范围的单元格，从下到上插入行。

Option Explicit

Sub InsertRows()
    
    Const fRow As Long = 2 ' First Row
    Const dtCol As String = "A" ' Date Column
    Const RowsToInsert As Long = 3
    
    ' Pick one:
    ' 1. Either (bad, but sometimes necessary)...
    'Dim ws As Worksheet: Set ws = ActiveSheet ' could be the wrong one
    ' 2. ... or better...
    'Dim wb As Workbook: Set wb = ThisWorkbook  ' workbook containing this code
    'Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1") ' name
    ' 3. ... or best:
    Dim ws As Worksheet: Set ws = Sheet1 ' code name (not in parentheses)
    
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, dtCol).End(xlUp).Row
    
    Dim irg As Range ' Insert Range
    Dim pMonth As Long ' Previous Month
    Dim cMonth As Long ' Current Month
    Dim cValue As Variant ' Current Cell Value
    Dim cOffset As Long ' Column Offset for GetCombinedRangeReverse
    Dim r As Long
    
    For r = fRow To lRow
        cValue = ws.Cells(r, dtCol).Value
        If IsDate(cValue) Then ' a date
            cMonth = Month(cValue)
            If cMonth <> pMonth Then ' a different month
                pMonth = cMonth
                ' Changing the column to cover consecutive different months.
                cOffset = IIf(cOffset = 0, 1, 0)
                Set irg = GetCombinedRangeReverse(irg, _
                    ws.Cells(r, dtCol).Offset(, cOffset))
            Else ' the same month
            End If
        Else ' not a date
        End If
    Next r
    
    If irg Is Nothing Then Exit Sub
    
    ' This loop is running from bottom to top due to 'GetCombinedRangeReverse'.
    Dim iCell As Range
    For Each iCell In irg.Cells
        iCell.Resize(RowsToInsert).EntireRow.insert
    Next iCell

    MsgBox "Rows inserted.", vbInformation, "Insert Rows"

End Sub

Function GetCombinedRangeReverse( _
    ByVal CombinedRange As Range, _
    ByVal AddRange As Range) _
As Range
    If CombinedRange Is Nothing Then
        Set GetCombinedRangeReverse = AddRange
    Else
        Set GetCombinedRangeReverse = Union(AddRange, CombinedRange)
    End If
End Function