Question

我在列中有数据，我正在尝试运行一个宏，以便每次找到新值时都插入一个新行（预设行）。

以下是当前数据的示例：

1   C   100
1   D   100
1   E   100
1   F   100
1   G   100
2   C   200
2   D   200
2   E   200

我希望宏查看第一列，如果有新值，则插入一行（粘贴预定义的行）

这是结果：

1   C   100
1   D   100
1   E   100
1   F   100
1   G   100
Predefined line copied
2   C   200
2   D   200
2   E   200
Predefined line copied

我当前的代码看起来像这样。它不起作用：

Sub InsertCreditorLine()

'based on value in column AB, works out where new expense starts and inserts the creditor line formula row

Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim PrintArea1 As Variant
Dim R As Long
Dim StartRow As Long

' works out last row to work up from

    Col = "AB"
    StartRow = 6
    BlankRows = 1

        LastRow = Cells(Rows.Count, Col).End(xlUp).Row

        Application.ScreenUpdating = False

        With ActiveSheet
For R = LastRow To StartRow + 1 Step -1

'Looks to value in column AB to see where new expense starts

If .Cells(R, Col) = "Y" Then

'paste in line


Rows("1:13").Select
Selection.EntireRow.Hidden = False

.Cells(7, 7).EntireRow.Copy
.Cells(R, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.CutCopyMode = False

Answer 1

这个怎么样？

Sub InsertCreditorLine()
    Dim startRow As Long, lastRow As Long, presetRow As Range, rw As Long

    startRow = 6
    lastRow = Range("AB" & Rows.Count).End(xlUp).Row
    Set presetRow = Range("7:7")

    For rw = lastRow To startRow + 1 Step -1
        If Range("AB" & rw) <> Range("AB" & rw).Offset(-1, 0) Then
            presetRow.Copy
            Range("AB" & rw).Insert Shift:=xlDown
        End If
    Next rw
End Sub

每个新引用显示在列中后插入行

1 个答案: