删除空白行（ROWS）

Question

我无法使此代码以我想要的方式工作。

它当前正在删除空白行，但是正在删除行之间的空白，我不想发生这种情况。我希望删除填充行和列G中最后一个填充单元格之后的所有内容之间的空白行。有人能帮我吗。我加了一张照片来帮助。突出显示的黄色单元格需要保留，我要删除蓝色的行。

Public Sub DeleteBlankLines()

' Declaring the variables
Dim WS As Worksheet
Dim UncWs As Worksheet, RepWs As Worksheet, ImpWs As Worksheet
Dim StopAtData As Boolean
Dim UserAnswer As Variant
Dim rngDelete As Range, UncDelete As Range, RepDelete As Range, ImpDelete As Range
Dim RowDeleteCount As Integer

'Set Worksheets
Set UncWs = ThisWorkbook.Sheets("Uncertainty")
Set RepWs = ThisWorkbook.Sheets("Repeatability")
Set WS = ThisWorkbook.Sheets("Datasheet")
Set ImpWs = ThisWorkbook.Sheets("Import Map")

'Set Delete Variables to Nothing
Set rngDelete = Nothing
Set UncDelete = Nothing
Set RepDelete = Nothing
Set ImpDelete = Nothing

RowDeleteCount = 0

'Determine which cells to delete
UserAnswer = MsgBox("Do you want to delete empty rows " & _
"outside of your data?" & vbNewLine, vbYesNoCancel)

If UserAnswer = vbYes Then
    StopAtData = True

    'Not needed Turn off at Call in Form
    'Application.Calculation = xlCalculationManual
    'Application.ScreenUpdating = False
    'Application.EnableEvents = False

    ' Set Range
     DS_LastRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row

    For CurrentRow = DS_StartRow To DS_LastRow Step 1

        ' Delete blank rows by checking the value of cell in column G (Nominal Value)
       With WS.Range("G" & CurrentRow & ":O" & CurrentRow)
            If WorksheetFunction.CountBlank(.Cells) >= 9 Then
               If rngDelete Is Nothing Then
                    Set rngDelete = WS.Rows(CurrentRow)
                    Set UncDelete = UncWs.Rows(CurrentRow)
                    Set RepDelete = RepWs.Rows(CurrentRow)
                    Set ImpDelete = ImpWs.Rows(CurrentRow)
                    RowDeleteCount = 1
               Else
                    Set rngDelete = Union(rngDelete, WS.Rows(CurrentRow))
                    Set UncDelete = Union(UncDelete, UncWs.Rows(CurrentRow))
                    Set RepDelete = Union(RepDelete, RepWs.Rows(CurrentRow))
                    Set ImpDelete = Union(ImpDelete, ImpWs.Rows(CurrentRow))
                    RowDeleteCount = RowDeleteCount + 1
               End If
           End If

        End With
    Next CurrentRow

Else
    Exit Sub

End If

'Refresh UsedRange (if necessary)
If RowDeleteCount > 0 Then
    UserAnswer = MsgBox("This will Delete " & RowDeleteCount & " rows, Do you want to delete empty rows?" & vbNewLine, vbYesNoCancel)

    If UserAnswer = vbYes Then
         ' Delete blank rows
        If Not rngDelete Is Nothing Then
          UncWs.Unprotect ("$1mco")
          RepWs.Unprotect ("$1mco")

          rngDelete.EntireRow.Delete Shift:=xlUp
          UncDelete.EntireRow.Delete Shift:=xlUp
          RepDelete.EntireRow.Delete Shift:=xlUp
          ImpDelete.EntireRow.Delete Shift:=xlUp

          UncWs.Protect "$1mco", , , , , True, True
          RepWs.Protect ("$1mco")

        End If
    Else
        MsgBox "No Rows will be Deleted.", vbInformation, "No Rows Deleted"
    End If
Else
    MsgBox "No blank rows were found!", vbInformation, "No Blanks Found"

End If

' Set New Last Row Moved to Event
DS_LastRow = WS.Range("G7:G" & WS.Rows.Count).End(xlUp).Row


'Not needed Turn on at Call in Form
'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
'Application.EnableEvents = True

End Sub

Answer 1

也许是这样，

dim lr as long

with ThisWorkbook.Sheets("Datasheet")

    lr = .cells.find(what:="*", after:=.cells(1), _
                     LookIn:=xlFormulas, LookAt:=xlPart, _
                     SearchOrder:=xlByRows, SearchDirection:=xlprevious).row 

    .usedrange.offset(lr, 0).entirerow.clear

end with

Answer 2

删除最后一行以下

删除列中最后使用的行下方的所有数据。

代码

'*******************************************************************************
' Purpose:    Deletes all data below the last used row of a specified column.
'*******************************************************************************
Sub DeleteBelowLastRow()

    Const cVntSheet As Variant = "Sheet1"  ' Worksheet Name/Index
    Const cVntColumn As Variant = "G"      ' Last Row Column Letter/Number

    Dim lngLastRow As Long   ' Last Row

    With ThisWorkbook.Worksheets(cVntSheet)
        lngLastRow = .Cells(.Rows.Count, cVntColumn).End(xlUp).Row
        .Range(.Cells(lngLastRow + 1, 1), .Cells(.Rows.Count, 1)) _
                .EntireRow.Delete
    End With

End Sub
'*******************************************************************************