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

Excel 在列中显示每个新引用后插入行,excel,macros,vba,Excel,Macros,Vba,我在一列中有数据,我正在尝试运行一个宏,以便在每次找到新值时插入一个新行(预设行) 以下是数据当前外观的示例: 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

我在一列中有数据,我正在尝试运行一个宏,以便在每次找到新值时插入一个新行(预设行)

以下是数据当前外观的示例:

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
这个怎么样

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
Sub InsertCreditorLine()
变暗开始时变长,最后一行变长,预设行变长,rw变长
startRow=6
lastRow=范围(“AB”和Rows.Count).End(xlUp).Row
设置预设行=范围(“7:7”)
对于rw=从最后一行到startRow+1步骤-1
如果范围(“AB”和rw)范围(“AB”和rw)。偏移(-1,0),则
行,收到
范围(“AB”和rw)。插入移位:=xlDown
如果结束
下一个rw
端接头

如果.Cells(R,Col)=“Y”,那么
您有数字,为什么要测试
Y
?@findwindw可能是一个公式,用于检查前一行的值是否与实际行的值不同(如果不同,则返回“Y”)。。。还有一个问题,为什么要一直走到第6排,但要从第1排到第13排。如果为真,则可以取消该步骤。为什么要在末尾复制一行(在
2e2001之后)?当值从
1
变为
2
时,我得到了第一份副本。@AlexP猜测它变为3,但OP忽略了它。这是预期的。我使用偏移量(-1,0)
向前看一行,将当前行与下一行进行比较。Hello@alex-p,我收到一个错误1004,它说明复制粘贴区域必须相同。我可以确认所有列和行的大小都相同。好的,我可以通过复制粘贴解决这个问题。基本上预设行。复制范围(“AB”&rw)。插入移位:=xlDown需要预设行。复制范围(“A”&rw)。插入移位:=xlDown,但我遇到了另一个问题。最后一行也是唯一的,因此需要在其下方粘贴一个预定义的行。宏似乎拾取所有行,但不考虑最后一行。因此,基本上,在宏循环完成后,最后一行始终是预定义的行。