Question

我的宏的目标是简单地复制其中值为1的任何行的单元格，并将相同的值插入其正上方的另一行。唯一需要注意的是我在B和B列中也有值。 C所以我想复制和插入那些。我的宏位于

之下

我已经认识到问题是excel是采用Columns AR而不是范围AR但是我在解决这个方面遇到了一些麻烦，因为我不能想到以另一种方式命名我的R变量以绕过问题。 / p>

非常感谢你的帮助！

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变量中的整数（即.Cells(R, Col + 2))中的 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％确定这是否是您所追求的。

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

1 个答案: