时间戳

首页 > 解决方案 > 如何获取一个月的第一个实例并添加新行（包括屏幕截图）

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

问题描述

请参阅下面我的 Excel 电子表格的图像。

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

我当前的 VBA 代码Sub insert()（显示在我的图像文件下）使用LEFT()单元格 A2 上的函数，但它没有返回我想要的值，即“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

标签： excelvbaexcel-formula

解决方案

在月度变化时插入行

  • 在 column 的单元格中的每个月份更改时A，它将3在单元格上方插入行。
  • 它从上到下循环并将关键单元格（或它们旁边的单元格）组合成一个范围：首先是当前单元格，然后是先前组合的单元格。它在单元格和它们旁边的单元格之间交替，以不获取多个单元格的范围（Application.Union在GetCombinedRangeReverse：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

推荐阅读