计算空白行数

Question

I have a database of peptide sequences. I would like to add the different numbers of blank rows under the protein's name so I could analyze the data in the next step.

The blank rows are in column D, eg 73 blank rows for Solyc09g007080.3.1, as shown in this screenshot.

I found code to add specific numbers of blank rows under each row and I adjusted that code to be used with my list. It only runs for two protein names every time I run the code when I chose about 34,000 numbers in column D for the blank rows to be added.

Sub InsertSpecificNumberOfBlankRows()
    Dim xRg As Range
    Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long

    Set xRg = Selection
    If xRg Is Nothing Then Resume Next
    Application.ScreenUpdating = False
    xLastRow = xRg(1).End(xlDown).Row
    xFstRow = xRg.Row
    xCol = xRg.Column
    xCount = xRg.Count

    For I = xLastRow To xFstRow Step -1
        xNum = Cells(I, xCol)
        If IsNumeric(xNum) And xNum > 0 Then
            Rows(I + 1).Resize(xNum).Insert
            xCount = xCount + xNum
        End If
    Next
    Application.ScreenUpdating = True

End Sub

Answer 1

Insert Empty Rows

Option Explicit

Sub InsertSpecificNumberOfBlankRows()

    If Not TypeOf Selection Is Range Then Exit Sub ' 'Selection' is not a range
    
    Dim srg As Range: Set srg = Selection.Columns(1)
    Dim ws As Worksheet: Set ws = srg.Worksheet
    
    Dim sLastRow As Long: sLastRow = srg.Cells(srg.Rows.Count).Row
    Dim sFirstRow As Long: sFirstRow = srg.Row
    Dim sCol As Long: sCol = srg.Column
    
    Application.ScreenUpdating = False

    Dim sValue As Variant
    Dim irCount As Long
    Dim r As Long
    
    For r = sLastRow To sFirstRow Step -1
         sValue = ws.Cells(r, sCol).Value
         If IsNumeric(sValue) Then
             If sValue >= 1 Then
                 ws.Rows(r + 1).Resize(sValue).Insert _
                      xlShiftDown, xlFormatFromLeftOrAbove
                 irCount = irCount + sValue
             End If
         End If
    Next r
     
    Application.ScreenUpdating = True

    MsgBox "Inserted " & irCount & " rows.", vbInformation

End Sub