在Excel表格中插入空行

的数据

Sub InsertBlankRows()

    Const WORKSHEET_NAME As String = "Sheet1"
    Const TABLE_ID As Variant = "Table1"
    Const TABLE_COLUMN As Variant = "Data.Source"
    Const BEGINS_WITH As String = "SB" ' or e.g. "SB_HR_"
    Const INSERT_ROWS_COUNT As Long = 2
  
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Sheets(WORKSHEET_NAME)
    
    Dim lo As ListObject: Set lo = ws.ListObjects(TABLE_ID)
    
    ' Remove existing filters.
    If lo.ShowAutoFilter Then
        If lo.AutoFilter.FilterMode Then
            lo.AutoFilter.ShowAllData
        End If
    End If
    
    Dim lc As ListColumn: Set lc = lo.ListColumns(TABLE_COLUMN)
    
    Dim rg As Range: Set rg = lo.DataBodyRange
    Dim rCount As Long: rCount = rg.Rows.Count
        
    Dim cData()
        
    If rCount = 1 Then
        ReDim cData(1 To 1, 1 To 1): cData(1, 1) = lc.DataBodyRange.Value
    Else
        cData = lc.DataBodyRange.Value
    End If
    
    Application.ScreenUpdating = False
    
    Dim r As Long, rStr As String
    
    For r = rCount To 1 Step -1
        rStr = CStr(cData(r, 1).Value)
        If InStr(1, rStr, BEGINS_WITH, vbTextCompare) = 1 Then
            rg.Rows(r + 1).Resize(INSERT_ROWS_COUNT) _
                .Insert xlShiftDown, xlFormatFromLeftOrAbove
        End If
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox "Blank rows inserted.", vbInformation

End Sub

字符串

• 请注意，您可以使用Application.Match，如delete-rows code所示。

请也试试下一种方式。它把要处理的范围放在一个数组中（为了更快的处理），并创建一个Union范围，其中包含要插入的必要行。它在结尾处立即插入，对于合理的出现次数来说是快速的：

Sub insertRows(rng As Range, pref As String, noRows As Long)
  Dim URng As Range, arr, i As Long
  
  arr = rng.Value2
  For i = 1 To UBound(arr)
    If left(arr(i, 1), Len(pref)) = pref Then
      addToRange URng, rng.Parent.Range(i + rng.row & ":" & i + rng.row + noRows - 1)
    End If
  Next i
  
  If Not URng Is Nothing Then URng.insert xlDown
End Sub

字符串
它应该以下面的方式调用（对于变量插入数）：

Sub testInsertRows()
  Dim sh As Worksheet, lastR As Long, rng As Range
  
  Set sh = ActiveSheet 'use here the sheet you need
  lastR = sh.Range("H" & sh.rows.count).End(xlUp).row
  Set rng = sh.Range("H2:H" & lastR)
  insertRows rng, "SB", 3
End Sub

型
创建Union范围所需的Sub（复制到标准模块中，通常也是上面代码所在的模块）：

Sub addToRange(rngU As Range, rng As Range)
    If rngU Is Nothing Then
        Set rngU = rng
    Else
        Set rngU = Union(rngU, rng)
    End If
End Sub

型

Dim cRows as Long, i as long,j as Long
cRows=ActiveSheet.UsedRange.Rows.count
For i=cRows to 1 step-1
If Left(Cells(i,8),2)="SB" Then 
For j=1 to 15
Rows(i+1).EntireRow.Insert
next j
End If
Next i

字符串
差不多吧