VBA-在创建的每个空行中输入值

我有一个vba代码，该代码在每一行后面创建一个空行，值为：

一排 第2排 第3排 输出 第1行

第2排

第3排

在空行中，我想插入值check1，check2，check和autonumber的自动增量

要获得以下内容的最终输出：

一排 支票1 第2排 支票2 第n排 支票 以下是我开始的代码：

Sub Insert_Blank_Rows()

 'Select last row in worksheet.
Selection.End(xlDown).Select

Do Until ActiveCell.Row = 1
     'Insert blank row.
    ActiveCell.EntireRow.Insert shift:=xlDown
     'Move up one row.
    ActiveCell.Offset(-1, 0).Select
Loop
End Sub

---

所以每隔一行都是空的，你想填充它吗？其中一种方法是

finalRow = cells(1000000,1).end(xlup).row
yourIncrement = 1
for i = 1 to finalRow
    if isempty(cells(i,1)) then
        cells(i,1) = "check" & yourIncrement
        yourIncrement = yourIncrement + 1
    end if
next i

---

我假设您要填充第1A列。

因此每隔一行都是空的，您要填充吗？其中一种方法是

finalRow = cells(1000000,1).end(xlup).row
yourIncrement = 1
for i = 1 to finalRow
    if isempty(cells(i,1)) then
        cells(i,1) = "check" & yourIncrement
        yourIncrement = yourIncrement + 1
    end if
next i

我假设您想填写第1A列。

这是怎么回事

Sub Insert_Blank_Rows()
Dim lastRow&, i&

'Assuming column A has the most data (if not change the `1` to whatever column # does have the most data
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

'Select last row in worksheet.
'Selection.End(xlDown).Select  ' Don't use `.Select`
i = 2
Do While i <= lastRow
    Rows(i).Select
    Rows(i).EntireRow.Insert shift:=xlDown
    Cells(i, 1).Value = "Check " & Cells(i - 1, 1).Value
    Cells(i, 1).Value = Cells(i, 1).Value
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    i = i + 2
Loop

End Sub

这个怎么样

Sub Insert_Blank_Rows()
Dim lastRow&, i&

'Assuming column A has the most data (if not change the `1` to whatever column # does have the most data
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

'Select last row in worksheet.
'Selection.End(xlDown).Select  ' Don't use `.Select`
i = 2
Do While i <= lastRow
    Rows(i).Select
    Rows(i).EntireRow.Insert shift:=xlDown
    Cells(i, 1).Value = "Check " & Cells(i - 1, 1).Value
    Cells(i, 1).Value = Cells(i, 1).Value
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    i = i + 2
Loop

End Sub

---

这是一种快速、简单、高效的方法，只需对当前代码进行最小的调整

Sub Insert_Blank_Rows()

Dim rng as Range
Set rng = Selection ' grab top most cell in range, you may want to actually refer to the actual cell.
rng.End(xlDown).Select 'Select last row in worksheet.

Do Until ActiveCell.Row = 1
     'Insert blank row.
    ActiveCell.EntireRow.Insert shift:=xlDown
     'Move up one row.
    ActiveCell.Offset(-1, 0).Select
Loop

'fill blanks with incremental checks
Dim rngBottom as Range
Set rngBottom = Cells(rows.Count,rng.Column).End(xlUp).Offset(1)

Range(rng, rngBottom).SpecialCells(xlCellTypBlanks).FormulaR1C1 = "=""Check""&ROW()/2"

End Sub

---

这是一种快速、简单、高效的方法，只需对当前代码进行最小的调整

Sub Insert_Blank_Rows()

Dim rng as Range
Set rng = Selection ' grab top most cell in range, you may want to actually refer to the actual cell.
rng.End(xlDown).Select 'Select last row in worksheet.

Do Until ActiveCell.Row = 1
     'Insert blank row.
    ActiveCell.EntireRow.Insert shift:=xlDown
     'Move up one row.
    ActiveCell.Offset(-1, 0).Select
Loop

'fill blanks with incremental checks
Dim rngBottom as Range
Set rngBottom = Cells(rows.Count,rng.Column).End(xlUp).Offset(1)

Range(rng, rngBottom).SpecialCells(xlCellTypBlanks).FormulaR1C1 = "=""Check""&ROW()/2"

End Sub

---

给，我给你拿了一个。我已经测试了它，并工作良好的要求

在我的代码中哪一个是特殊的？我的代码不会漏掉任何一行。完美的自动增量

我还引用了BruceWayne的代码，因为我不想编辑他自己的代码

Sub checkingData()

    Dim exeRow As Integer 'For indexing the executing row
    Dim lastRow As Integer 'For storing last row

    exeRow = 2 'Checking from first row

    'Assume that First Column has more data row than Other Column
    lastRow = Cells(Rows.Count, 1).End(xlUp).row

    'Loop from First Row to Last Row
    Do While exeRow <= lastRow + 1

        'Select data row
        Rows(exeRow).Select

        'Insert row below data row
        Rows(exeRow).EntireRow.Insert shift:=xlDown

        'Set auto-increment result
        Cells(exeRow, 1) = "Check " & (exeRow / 2)

        'Increase lastRow count because of adding blank row
        lastRow = lastRow + 1

        'Go to next data row
        exeRow = exeRow + 2

    Loop

End Sub

---

给，我给你拿了一个。我已经测试了它，并工作良好的要求

在我的代码中哪一个是特殊的？我的代码不会漏掉任何一行。完美的自动增量

我还引用了BruceWayne的代码，因为我不想编辑他自己的代码

Sub checkingData()

    Dim exeRow As Integer 'For indexing the executing row
    Dim lastRow As Integer 'For storing last row

    exeRow = 2 'Checking from first row

    'Assume that First Column has more data row than Other Column
    lastRow = Cells(Rows.Count, 1).End(xlUp).row

    'Loop from First Row to Last Row
    Do While exeRow <= lastRow + 1

        'Select data row
        Rows(exeRow).Select

        'Insert row below data row
        Rows(exeRow).EntireRow.Insert shift:=xlDown

        'Set auto-increment result
        Cells(exeRow, 1) = "Check " & (exeRow / 2)

        'Increase lastRow count because of adding blank row
        lastRow = lastRow + 1

        'Go to next data row
        exeRow = exeRow + 2

    Loop

End Sub

---

我将加入这个解决方案，没有循环也没有插入 对于20k行，速度非常快，不到1秒

Option Explicit

Sub main()
    Dim helperCol As Range

    With ActiveSheet.UsedRange
        Set helperCol = .Columns(.Columns.Count + 1)
    End With

    With Range(ActiveCell, ActiveCell.End(xlDown))
        .Offset(, helperCol.Column - .Column).Formula = "=ROW()"
        With .Offset(.Rows.Count)
            .Formula = "=CONCATENATE(""check"",ROW()-" & .Rows.Count & ")"
            .Value = .Value
            With .Offset(, helperCol.Column - .Column)
                .Formula = "=ROW()-" & .Rows.Count & "+ 0.1"
                .Value = .Value
            End With
        End With
        .Resize(2 * .Rows.Count, helperCol.Column - .Column + 1).Sort Key1:=helperCol.Resize(2 * .Rows.Count), Header:=xlNo
        helperCol.Resize(2 * .Rows.Count).Clear
    End With
End Sub

---

根据OP的要求，它需要从ActiveCell移动，我将加入这个解决方案，没有循环也没有插入 对于20k行，速度非常快，不到1秒

Option Explicit

Sub main()
    Dim helperCol As Range

    With ActiveSheet.UsedRange
        Set helperCol = .Columns(.Columns.Count + 1)
    End With

    With Range(ActiveCell, ActiveCell.End(xlDown))
        .Offset(, helperCol.Column - .Column).Formula = "=ROW()"
        With .Offset(.Rows.Count)
            .Formula = "=CONCATENATE(""check"",ROW()-" & .Rows.Count & ")"
            .Value = .Value
            With .Offset(, helperCol.Column - .Column)
                .Formula = "=ROW()-" & .Rows.Count & "+ 0.1"
                .Value = .Value
            End With
        End With
        .Resize(2 * .Rows.Count, helperCol.Column - .Column + 1).Sort Key1:=helperCol.Resize(2 * .Rows.Count), Header:=xlNo
        helperCol.Resize(2 * .Rows.Count).Clear
    End With
End Sub

---

根据OP的要求，需要从ActiveCell移动

如何在最后一行后再添加一个checkNo？很高兴听到。万事如意。将finalRow=cells1000000，1.endxlup.row更改为finalRow=cells1000000.endxlup.row+1。如何在最后一行后再添加一个checkNo？很高兴听到。一切都好。将finalRow=cells1000000，1.endxlup.row更改为finalRow=cells1000000.endxlup.row+1。我理解希望代码尽可能接近OP的原始代码，但我个人认为这是OP学习避免使用的一个绝好机会。我喜欢你这样做，很聪明！它比我的强，这是相当野蛮的力量…@BruceWayne-我同意直接使用对象而不是.Select。这一次我没必要这么做，xlCellTypBlanks有点输入错误。除此之外，我测试了20k行，大约需要50秒。虽然像我刚刚发布的解决方案只需要不到一秒钟的时间，但我理解希望代码尽可能接近OP的原始版本，但我个人认为这是OP学习避免使用的一个很好的机会。我喜欢你这样做，很聪明！它比我的强，这是相当野蛮的力量…@BruceWayne-我同意直接使用对象而不是.Select。这一次我没必要这么做，xlCellTypBlanks有点输入错误。除此之外，我测试了20k行，大约需要50秒。而我刚刚发布的解决方案只需要不到一秒钟的时间