Question

我当前遇到的问题是单击几次按钮后无法正确复制和插入行。我要实现的逻辑是复制标题以外的每一行，并追加到下一行。请参考提供的图像。

下面是我的代码，很乱。我是VBA的新手，请引导我，谢谢。

Sub bt_add()

Dim a1 As Integer
Dim a2 As Integer
Dim a3 As Integer
Dim a4 As Integer
Dim a5 As Integer
Dim a6 As Integer
Dim a7 As Integer
Dim a8 As Integer
Dim a9 As Integer
Dim a10 As Integer
Dim a11 As Integer
Dim a12 As Integer
Dim n As Integer
Dim s As Integer

Static clicked As Integer

a1 = 2
a2 = 3
a3 = 6
a4 = 7
a5 = 10
a6 = 11
a7 = 14
a8 = 15
a9 = 18
a10 = 19
a11 = 22
a12 = 23

n = clicked
s = clicked + 1

If clicked = 0 Then
    a1 = 2
    a2 = 3
    a3 = 6
    a4 = 7
    a5 = 10
    a6 = 11
    a7 = 14
    a8 = 15
    a9 = 18
    a10 = 19
    a11 = 22
    a12 = 23

    clicked = clicked + 1
Else
    If clicked >= 2 Then
        a1 = a1 + n
        a2 = a2 + n
        a3 = a2 * 2
        a4 = a2 * 2 + 1
        a5 = a5 + n + 1 + s
        a6 = a6 + n + 1 + s
        a7 = a7 + n + 3 + s
        a8 = a8 + n + 3 + s
        a9 = a9 + n + 5 + s
        a10 = a10 + n + 5 + s
        a11 = a11 + n + 7 + s
        a12 = a12 + n + 7 + s

        clicked = clicked + 1
    Else
        a1 = a1 + n
        a2 = a2 + n
        a3 = a2 * 2
        a4 = a2 * 2 + 1
        a5 = a5 + n + 2
        a6 = a6 + n + 2
        a7 = a7 + n + 3
        a8 = a8 + n + 3
        a9 = a9 + n + 4
        a10 = a10 + n + 4
        a11 = a11 + n + 5
        a12 = a12 + n + 5

        clicked = clicked + 1
    End If

End If



'MsgBox a1 & ", " & a2 & ", " & a3 & ", " & a4 & ", " & a5 & ", " & a6 & ", " & a7 & ", " & a8 & ", " & a9 & ", " & a10 & ", " & a11 & ", " & a12 & ", " & n & ", " & s

Selection.Copy
Rows(a1).EntireRow.Copy
Rows(a2).Select
Selection.Insert Shift:=xlDown
Rows(a3).EntireRow.Copy
Rows(a4).Select
Selection.Insert Shift:=xlDown
Rows(a5).EntireRow.Copy
Rows(a6).Select
Selection.Insert Shift:=xlDown
Rows(a7).EntireRow.Copy
Rows(a8).Select
Selection.Insert Shift:=xlDown
Rows(a9).EntireRow.Copy
Rows(a10).Select
Selection.Insert Shift:=xlDown
Rows(a11).EntireRow.Copy
Rows(a12).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

End Sub

Answer 1

如果这是您要寻找的*，则宏假定您在每个小节之间始终只保留一个空白行。这将复制每个小节中的最后一行，并将其插入到下面，同时保留下一张表之前的下面的空白行。

Option Explicit

Sub InsertRows()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim i As Long, LR As Long

LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1).Row

'Application.ScreenUpdating = False
    For i = LR To 1 Step -1
        If ws.Range("A" & i) = "" Then
            ws.Range("A" & i + 1).EntireRow.Insert
            ws.Range("A" & i - 1).EntireRow.Copy ws.Range("A" & i)
        End If
    Next i
'Application.ScreenUpdating = True

End Sub

Excel VBA复制多行并根据按钮单击插入到下一行

1 个答案: