Excelmacros使用预定义的格式和公式创build新行

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

我使用下面的macros来添加一个空白行，其中的值为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 

有没有办法插入行（与上面的macros相同）与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