Excel VBA插入复制的单元格语法

Question

我的宏的目标太简单了，就是复制其中任何值为1的行的单元格，然后将相同的值插入到其上方的另一行中。 唯一的警告是我在B和C列中也有值，因此我也希望复制和插入这些值。 我的宏在下面

我已经意识到问题在于excel是采用Column AR而不是Range AR，但是我很难解决这个问题，因为我无法想到以其他方式命名R变量来绕过该问题。

非常感谢您的帮助！

Sub BlankLine()

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

    Col = "A"
    StartRow = 1
    BlankRows = 1

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

    Application.ScreenUpdating = False

    With ActiveSheet
        For R = LastRow To StartRow + 1 Step -1
            If .Cells(R, Col) = "1" Then
                .Range("AR:CR").Copy
                Selection.Insert Shift:=xlDown
            End If
        Next R
    End With
    Application.ScreenUpdating = True

End Sub

Answer 1

更新：我将代码更改为仅复制这三列（A到C），然后插入新行，然后将值设置为这三列。 注释在代码中。 如果要复制多个列，只是改变的整数dupRange变量（即2 .Cells(R, Col + 2))

Sub BlankLines()

Dim Col As Integer
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

Col = 1 'changed to number
StartRow = 2 'changed to 2 since you have a header
BlankRows = 1 'not used in this code...

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

Application.ScreenUpdating = False

With ActiveSheet
    For R = LastRow To StartRow Step -1
        If .Cells(R, Col) = "1" Then
            Dim dupRange As Variant 'array to store values
            Set dupRange = .Range(.Cells(R, Col), .Cells(R, Col + 2)) 'store the column values for the row
            .Rows(R & ":" & R).Insert Shift:=xlDown 'insert the new row
            c = 0 'to increment over the copied columns
            For Each v In dupRange
                .Cells(R, Col + c) = v 'sets the array values to each column
                c = c + 1
            Next v
        End If
    Next R
End With

Application.ScreenUpdating = True

End Sub

试试看。 不能100％确定这是否是您要的。