Excel VBA - Удалить пустые строки

Question

Я хотел бы удалить пустые строки, создаваемые моей котировкой ERP. Я пытаюсь пройти через документ (A1:Z50) и для каждой строки, где нет данных в ячейках (A1-B1...Z1 = empty, A5-B5...Z5 = empty) Я хочу их удалить.

Я нашел это, но не могу настроить его для меня.

On Error Resume Next 
Worksheet.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
On Error GoTo 0 

Answer 1

Как насчет

sub foo() 
    dim r As Range, rows As Long, i As Long 
    Set r = ActiveSheet.Range("A1:Z50") 
    rows = r.rows.Count 
    For i = rows To 1 Step (-1) 
    If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete 
    Next 
End Sub 

Answer 2

Попробуйте

Option Explicit 

Sub Sample() 
    Dim i As Long 
    Dim DelRange As Range 

    On Error GoTo Whoa 

    Application.ScreenUpdating = False 

    For i = 1 To 50 
     If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then 
      If DelRange Is Nothing Then 
       Set DelRange = Range("A" & i & ":" & "Z" & i) 
      Else 
       Set DelRange = Union(DelRange, Range("A" & i & ":" & "Z" & i)) 
      End If 
     End If 
    Next i 

    If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp 
LetsContinue: 
    Application.ScreenUpdating = True 

    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub 

Если вы хотите удалить всю строку затем использовать этот код

Option Explicit 

Sub Sample() 
    Dim i As Long 
    Dim DelRange As Range 

    On Error GoTo Whoa 

    Application.ScreenUpdating = False 

    For i = 1 To 50 
     If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then 
      If DelRange Is Nothing Then 
       Set DelRange = Rows(i) 
      Else 
       Set DelRange = Union(DelRange, Rows(i)) 
      End If 
     End If 
    Next i 

    If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp 
LetsContinue: 
    Application.ScreenUpdating = True 

    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub 

Answer 3

Чтобы немного сделать ответ Alex Д.К. более динамичный вы могли бы использовать код b Elow:

Sub DeleteBlankRows() 

Dim wks As Worksheet 
Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _ 
    lngColCounter As Long 
Dim blnAllBlank As Boolean 
Dim UserInputSheet As String 

UserInputSheet = Application.InputBox("Enter the name of the sheet which you wish to remove empty rows from") 

Set wks = Worksheets(UserInputSheet) 

With wks 
    'Now that our sheet is defined, we'll find the last row and last column 
    lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious).Row 
    lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _ 
          SearchOrder:=xlByColumns, _ 
          SearchDirection:=xlPrevious).Column 

    'Since we need to delete rows, we start from the bottom and move up 
    For lngIdx = lngLastRow To 1 Step -1 

     'Start by setting a flag to immediately stop checking 
     'if a cell is NOT blank and initializing the column counter 
     blnAllBlank = True 
     lngColCounter = 2 

     'Check cells from left to right while the flag is True 
     'and the we are within the farthest-right column 
     While blnAllBlank And lngColCounter <= lngLastCol 

      'If the cell is NOT blank, trip the flag and exit the loop 
      If .Cells(lngIdx, lngColCounter) <> "" Then 
       blnAllBlank = False 
      Else 
       lngColCounter = lngColCounter + 1 
      End If 

     Wend 

     'Delete the row if the blnBlank variable is True 
     If blnAllBlank Then 
      .rows(lngIdx).delete 
     End If 

    Next lngIdx 
End With 


MsgBox "Blank rows have been deleted." 

End Sub 

Это был получен из this website, а затем слегка адаптированный, чтобы позволить пользователю выбрать рабочий лист они хотят пустые строки удалены из.

Answer 4

Это работало отлично подходит для меня (вы можете настроить lastrow и lastcol при необходимости):

Sub delete_rows_blank2() 

t = 1 
lastrow = ActiveSheet.UsedRange.Rows.Count 
lastcol = ActiveSheet.UsedRange.Columns.Count 

Do Until t = lastrow 

For j = 1 To lastcol 

    If Cells(t, j) = "" Then 

     j = j + 1 

      If j = lastcol Then 
      Rows(t).Delete 
      t = t + 1 
      End If 

    Else 

     t = t + 1 

    End If 

Next 

Loop 

End Sub