在 Excel VBA 中的日期值后插入 x 行

Question

我正在嘗試在單元格值（即日期）后插入 x 行x =12 ，但我的代碼不起作用，請幫忙，

Sub HHRowInserter()
Dim HHRw As Range
For Each HHRw In Range("A1:A2251")
If HHRw.Value Like #9/30/2017# Then   'mm/dd/yyyy '30-Sep-17
HHRw.Offset(12, 0).EntireRow.Insert
End If
Next HHRw
End Sub

Answer 1

以下代碼行在 HHRw 下方 12 行的位置插入單行：

HHRw.Offset(12, 0).EntireRow.Insert

要插入 12 行，您需要聲明一個 12 行范圍：

Range(HHRw.Offset(1).Address & ":" & HHRw.Offset(12).Address).EntireRow.Insert

請記住，您的 For 循環是從第 1 行到第 2251 行循環。當您找到一個日期並粘貼 12 行時，您會將粘貼位置下方的所有內容向下推 12 行。 當您到達第 2251 行時，您可能會有大量超出該行的內容，並且您的 For 循環不會檢查這些內容。

您可能會解決此問題的一種方法是重新檢查最后使用的行並將循環轉換為 Do While：

Sub RowInserter()

    Dim LastRow As Integer, LoopCounter As Integer
    Dim TestCell As Range

    LoopCounter = 1
    LastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    Do While LoopCounter <= LastRow
        Set TestCell = Range("A" & LoopCounter)
        If IsDate(TestCell.Value) Then
            If DateValue(TestCell.Value) = DateValue("30-Sep-2017") Then
                Range(TestCell.Offset(1).Address & ":" & TestCell.Offset(12).Address).EntireRow.Insert
                LoopCounter = LoopCounter + 13
            Else
                LoopCounter = LoopCounter + 1
            End If
        Else
            LoopCounter = LoopCounter + 1
        End If
        LastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    Loop

End Sub