excel - Excel 宏使用预定义的格式和公式创建新行

Question

我有一个超过 2000 行的 Excel 表。

我使用下面的宏来添加一个空白行，其中 cloumn A1 的值发生了变化。

Sub AddBlankRows()
'
Dim iRow As Integer
Range("a1").Select
'
iRow = 1
'
Do
'![enter image description here][1]
If Cells(iRow + 1, 1) <> Cells(iRow, 1) Then
    Cells(iRow + 1, 1).EntireRow.Insert shift:=xlDown
    iRow = iRow + 2
Else
    iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, 1).Text = ""
'
End Sub

有没有办法用fourmula和预定义的格式插入行（与上面的宏相同） ？

Answer 1

下面是示例代码。

 Sub AddBlankRows()


    Dim lastRow As Long
    Dim iRow As Long
    Dim cursor As Long
    cursor = 2

    With ThisWorkbook.Sheets("sheet1")
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To lastRow
            If (LCase(Trim(.Cells(i, 1))) <> LCase(Trim(.Cells(i + 1, 1)))) Then
                .Cells(i + 1, 1).EntireRow.Insert shift:=xlDown
                .Cells(i + 1, 1).EntireRow.Interior.Color = vbYellow
                lastRow = lastRow + 1

                .Cells(i + 1, 2) = WorksheetFunction.Count(.Range(.Cells(cursor, 2), .Cells(i, 2)))
                .Cells(i + 1, 2).NumberFormat = "0"

                .Cells(i + 1, 3) = WorksheetFunction.Sum(.Range(.Cells(cursor, 3), .Cells(i, 3)))
                .Cells(i + 1, 3).NumberFormat = "0.00"


                i = i + 2
                cursor = i
            End If
        Next


        .Cells(lastRow + 1, 1).EntireRow.Insert shift:=xlDown
        .Cells(lastRow + 1, 1).EntireRow.Interior.Color = vbYellow

        .Cells(lastRow + 1, 2) = WorksheetFunction.Count(.Range(.Cells(cursor, 2), .Cells(lastRow, 2)))
        .Cells(lastRow + 1, 2).NumberFormat = "0"

        .Cells(lastRow + 1, 3) = WorksheetFunction.Sum(.Range(.Cells(cursor, 3), .Cells(lastRow, 3)))
        .Cells(lastRow + 1, 3).NumberFormat = "0.00"


    End With

End Sub