Vba excel удалить пустые строки в диапазоне

Удаление пустых строк с помощью кода VBA из всего задействованного диапазона рабочего листа Excel и из отдельного заданного диапазона.

Главный секрет удаления пустых строк кодом VBA Excel – это построчный просмотр диапазона или отдельного столбца снизу вверх, что исключает возможность при удалении найденных пустых строк получить бесконечный цикл и зависание программы.

Удаление пустых строк в используемом диапазоне

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

Определить границы используемого диапазона на рабочем листе из кода VBA Excel нам поможет последняя ячейка используемого диапазона: Cells.SpecialCells(xlLastCell).

Самый простой код удаления пустых строк

Сначала определяем номер строки последней ячейки задействованного на рабочем листе диапазона. Затем, с этой строки начинаем построчный просмотр используемого диапазона снизу вверх с поиском и удалением пустых строк.

Пример кода VBA Excel для активного листа:

Sub Primer1() Dim n As Long, i As Long ‘Определяем номер строки последней ячейки ‘используемого диапазона на рабочем листе n = Cells.SpecialCells(xlLastCell).Row     ‘Ищем и удаляем пустые строки     For i = n To 1 Step —1         If Rows(i).Text = «» Then Rows(i).Delete     Next End Sub

То же самое, но с указанием книги и рабочего листа:

Sub Primer2() Dim n As Long, i As Long     With ThisWorkbook.Worksheets(«Лист1»)         n = .Cells.SpecialCells(xlLastCell).Row             For i = n To 1 Step —1                 If .Rows(i).Text = «» Then .Rows(i).Delete             Next     End With End Sub

Программа определения времени выполнения макроса показала, что этот код отработал в диапазоне из 3000 строк за 17,5 секунд.

Улучшенный код удаления пустых строк

Предыдущий код VBA Excel анализирует на наличие текста каждую строку по всей длине в пределах рабочего листа. Эта процедура проверяет каждую строку по длине только в переделах используемого диапазона:

Sub Primer3() Dim n As Long, i As Long, myRange As Range ‘Присваиваем объектной переменной ссылку на диапазон от первой ячейки ‘рабочего листа до последней ячейки используемого диапазона Set myRange = Range(Range(«A1»), Cells.SpecialCells(xlLastCell))     With myRange         n = .Rows.Count         For i = n To 1 Step —1             If .Rows(i).Text = «» Then .Rows(i).Delete         Next     End With End Sub

Программа определения времени выполнения макроса показала, что этот код отработал в диапазоне из 3000 строк за 13,3 секунды.

Удаление строк по пустым ячейкам

Иногда может появиться необходимость удалить не только полностью пустые строки, но и строки с пустыми ячейками в определенном столбце. Тогда следует действовать так:

Sub Primer4() Dim n As Long, i As Long n = Cells.SpecialCells(xlLastCell).Row     For i = n To 1 Step —1         If Cells(i, 1).Text = «» Then Rows(i).Delete     Next End Sub

или так:

Sub Primer5() Dim n As Long, i As Long, myRange As Range Set myRange = Range(Range(«A1»), Cells.SpecialCells(xlLastCell))     With myRange         n = .Rows.Count         For i = n To 1 Step —1             If .Cells(i, 1).Text = «» Then .Rows(i).Delete         Next     End With End Sub

В этих примерах поиск пустой ячейки производится в первом столбце: Cells(i, 1).

Удаление пустых строк в заданном диапазоне

Процедуры VBA Excel для удаления пустых строк из заданного диапазона рассмотрим на примере объекта Selection, который можно заменить на любой диапазон, указанный явно.

Удаление полностью пустых строк в пределах заданного диапазона:

Sub Primer6() Dim n As Long, i As Long     With Selection         n = .Rows.Count         For i = n To 1 Step —1             If .Rows(i).Text = «» Then .Rows(i).Delete         Next     End With End Sub

Удаление строк по пустым ячейкам в одном из столбцов:

Sub Primer7() Dim n As Long, i As Long     With Selection         n = .Rows.Count         For i = n To 1 Step —1             If .Cells(i, 1).Text = «» Then .Rows(i).Delete         Next     End With End Sub

---

You need to test that there are any blanks.

If WorksheetFunction.CountBlank(Worksheet.Columns("A:A")) > 0 Then
    Worksheet.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If

You can just use On Error Resume Next to skip over the line if there are no blanks, but it’s generally preferable to test for a specific condition, rather than assuming you know what the error will be.

As far as I can see you’d only get the «No Cells Found» message if every cell in Column A has a value.

EDIT: Based on @brettdj’s comments, here’s an alternative that still uses CountBlank:

If WorksheetFunction.CountBlank(Intersect(worksheet.UsedRange, ws.Columns("A:A"))) > 0 Then
    worksheet.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If

Of course UsedRange is notoriously fickle and may be bigger than it appears. I think it’s best to first determine the actual range where the rows are to be deleted and then check the SpecialCells in that range, e.g.:

Sub DeleteRows()
Dim ws As Excel.Worksheet
Dim LastRow As Long

Set ws = ActiveSheet
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
With ws.Range("A2:A" & LastRow)
    If WorksheetFunction.CountBlank(.Cells) > 0 Then
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
End With
End Sub

One last note — I changed the variable from «worksheet» to «ws» as «worksheet» is an Excel reserved word.

This tutorial will demonstrate different ways to delete rows and columns in Excel using VBA.

Delete Entire Row or Column

To delete an entire row in VBA use this line of code:

Rows(1).Delete

Notice we use the Delete method to delete a row.

Instead of referencing the Rows Object, you can reference rows based on their Range Object with EntireRow:

Range("a1").EntireRow.Delete

Similarly to delete an entire column, use these lines of code:

Columns(1).Delete

Range("a1").EntireColumn.Delete

Delete Multiple Rows or Columns

Using the same logic, you can also delete multiple rows at once:

Rows("1:3").Delete

or columns:

Columns("A:C").Delete

Notice here we reference the specific row and column numbers / letters surrounded by quotations.

Of course, you can also reference the EntireRow of a range:

Range("a1:a10").EntireRow.Delete

Note: The examples below only demonstrate deleting rows, however as you can see above, the syntax is virtually identically to delete columns.

Delete Blank / Empty Rows

This example will delete a row if the entire row is blank:

Sub DeleteRows_EntireRowBlank()

Dim cell As Range

For Each cell In Range("b2:b20")
    If Application.WorksheetFunction.CountA(cell.EntireRow) = 0 Then
        cell.EntireRow.Delete
    End If
Next cell

End Sub

It makes use of the Excel worksheet function: COUNTA.

Delete Row if Cell is Blank

This will delete a row if specific column in that row is blank (in this case column B):

Range("b3:b20").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Delete Row Based on Cell Value

This will loop through a range, and delete rows if a certain cell value in that row says “delete”.

Sub DeleteRowswithSpecificValue()

Dim cell As Range

For Each cell In Range("b2:b20")
    If cell.Value = "delete" Then
        cell.EntireRow.Delete
    End If
Next cell

End Sub

More Delete Row and Column Examples

VBA Coding Made Easy

Stop searching for VBA code online. Learn more about AutoMacro — A VBA Code Builder that allows beginners to code procedures from scratch with minimal coding knowledge and with many time-saving features for all users!

Learn More

Delete Duplicate Rows

This code will delete all duplicate rows in a range:

Range("b2:c100").RemoveDuplicates Columns:=2

Notice we set Columns:=2. This tells VBA to check both the first two columns of data when considering if rows are duplicates. A duplicate is only found when both columns have duplicate values.

If we had set this to 1, only the first row would’ve been checked for duplicate values.

Delete Table Rows

This code will delete the second row in a Table by referencing ListObjects.

ThisWorkbook.Sheets("Sheet1").ListObjects("list1").ListRows(2).Delete

Delete Filtered Rows

To delete only rows that are visible after filtering:

Range("b3:b20").SpecialCells(xlCellTypeVisible).EntireRow.Delete

VBA Programming | Code Generator does work for you!

Delete Rows in Range

This code will delete all rows in range:

Range("a1:a10").EntireRow.Delete

Delete Selected Rows

This code will delete all selected rows:

Selection.EntireRow.Delete

Delete Last Row

This will delete the last used row in column B:

Cells(Rows.Count, 2).End(xlUp).EntireRow.Delete

By changing 2 to 1, you can delete the last used row in column A, etc.:

Cells(Rows.Count, 1).End(xlUp).EntireRow.Delete

Delete Columns by Number

To delete a column by it’s number, use a code like this:

Columns (2).Delete

Hashtag Пользователь Сообщений: 145 Регистрация: 05.02.2019

#1 07.03.2019 10:14:32 Здравствуйте, помогите пожалуйста доработать код. Он отвечает за удаление всех пустых строк на листе. Код Sub DeleteEmptyRows()     Dim r As Long, rng As Range     For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count         If Application.CountA(Rows(r)) = 0 Then             If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r))         End If         Debug.Print r     Next r     If Not rng Is Nothing Then rng.Delete     ActiveWorkbook.Save End Sub Задача заключается в следующем: 1. Заменить способ определения последней строки через UsedRange, поскольку он может определить строку с заливкой, как не пустую. Например на Find. Код Set rowvalue = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) r = rowvalue.Row 2. Определение и удаление пустых строк должно начинаться с 7 строки. Прикрепленные файлы Пример.xlsm (38.07 КБ)

Wild.Godlike Пользователь Сообщений: 616 Регистрация: 23.05.2018

#2 07.03.2019 10:23:33 Hashtag, Пользуйтесь P.S. Не с 7 строки только Строки Код Sub DelLine()   Dim i As Long   Dim diapaz1 As Range   Dim diapaz2 As Range Set diapaz1 = Application.Range(ActiveSheet.Range("A1"), _ ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)) For i = 1 To diapaz1.Rows.Count If WorksheetFunction.CountA(diapaz1.Rows(i).EntireRow) = 0 Then If diapaz2 Is Nothing Then Set diapaz2 = diapaz1.Rows(i).EntireRow Else Set diapaz2 = Application.Union(diapaz2, diapaz1.Rows(i).EntireRow) End If End If Next If diapaz2 Is Nothing Then MsgBox "Ненайдено ниодной пустой строки!" Else diapaz2.[Delete] End If End Sub Столбцы Код Sub DelColumn()   Dim i As Long   Dim diapaz1 As Range   Dim diapaz2 As Range Set diapaz1 = Application.Range(ActiveSheet.Range("A1"), _ ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)) For i = 1 To diapaz1.Columns.Count If WorksheetFunction.CountA(diapaz1.Columns(i).EntireColumn) = 0 Then If diapaz2 Is Nothing Then Set diapaz2 = diapaz1.Columns(i).EntireColumn Else Set diapaz2 = Application.Union(diapaz2, diapaz1.Columns(i).EntireColumn) End If End If Next If diapaz2 Is Nothing Then MsgBox "Ненайдено ниодного пустого столбца!" Else diapaz2.[Delete] End If End Sub Изменено: Wild.Godlike — 07.03.2019 10:25:20

Sanja Пользователь Сообщений: 14838 Регистрация: 10.01.2013	Не понял ЧТО удалять. Все пустые строки от 7-й до конца листа или пустые строки между заполненными? Согласие есть продукт при полном непротивлении сторон.

Hashtag Пользователь Сообщений: 145 Регистрация: 05.02.2019	Sanja От 7-й и до конца листа

Anchoret Пользователь Сообщений: 1059 Регистрация: 01.01.1970 Anchoret

#5 07.03.2019 12:24:58 Hashtag, последняя заполненная строка в столбце: Код Cells(Rows.Count,"A").End(xlUp).Row Цикл по строкам рабочего диапазона: Код Dim aa as Range, a&, bb as Range, b& For Each aa in Intersect(Columns(1), ActiveSheet.UsedRange)   If Application.CountA(Intersect(aa.EntireRow, ActiveSheet.UsedRange)) = 0 Then     If b=0 Then       Set bb=aa: b=1     Else Set bb=Union(bb, aa)     End if   End if Next If Not bb is Nothing Then bb.EntireRow.Delete Изменено: Anchoret — 07.03.2019 12:33:50

ocet p Пользователь Сообщений: 438 Регистрация: 24.03.2018	#6 07.03.2019 12:59:53 Цитата Hashtag написал: … он может определить строку с заливкой, как не пустую А ячейки с формулами, которые дают в результате пустую ячейку (например: «=IF(A9+A8=0;»»)»), пустые для вас или нет ?

Jack Famous Пользователь Сообщений: 10848 Регистрация: 07.11.2014 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome	Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Hashtag Пользователь Сообщений: 145 Регистрация: 05.02.2019	Wild.Godlike Anchoret Спасибо!

Jack Famous Пользователь Сообщений: 10848 Регистрация: 07.11.2014 OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome	Hashtag, и чем же вас варианты ОТСЮДА не устроили? Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Hashtag Пользователь Сообщений: 145 Регистрация: 05.02.2019	#10 11.03.2019 19:43:11 Jack Famous Не разобрался, как прикрутить вашу функцию к моему примеру, буду признателен если вы продемонстрируете на примере. Изменено: Hashtag — 11.03.2019 19:43:32

Исходные коды макросов для выделения, удаления, скрытия и добавления пустых строк в таблицу Excel по условию пользователя.

Как выделить все пустые строки макросом

Есть таблица годового бюджета, разделенная на отдельные группы статей расходов и кварталы. Каждая группа статей расходов разделена между собой пустыми строками:

Нам необходимо удалить все пустые строки в таблице. Для этого сначала необходимо их выделить. Если выделять вручную, то потребуется много времени и сил. Кроме того, нужно еще быть уверенным что строка действительно является пустой, чтобы вместе с ней не удалить важную информацию из бюджета или формулу. Для автоматического решения данной задачи лучше написать свой макрос, который сам проверит и выделит все пустые строки в таблице годового бюджета.

Откройте редактор Visual Basic (ALT+F11):

И воздайте в нем новый модуль для текущей книги «Insert»-«Module», а потом запишите в него следующий VBA-код макроса:

Sub SelectLine()
  Dim i As Long
  Dim diapaz1 As Range
  Dim diapaz2 As Range
Set diapaz1 = Application.Range(ActiveSheet.Range("A1"), _
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell))
For i = 1 To diapaz1.Rows.Count
If WorksheetFunction.CountA(diapaz1.Rows(i).EntireRow) = 0 Then
If diapaz2 Is Nothing Then
Set diapaz2 = diapaz1.Rows(i).EntireRow
Else
Set diapaz2 = Application.Union(diapaz2, diapaz1.Rows(i).EntireRow)
End If
End If
Next
If diapaz2 Is Nothing Then
MsgBox "Ненайдено ниодной пустой строки!"
Else
diapaz2.Select
End If
End Sub


Теперь если нам нужно автоматически выделить все пустые строки в таблице бюджета перед тем как их удалить, выберите инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«SelectLine»-«Выполнить». В результате выделяться все пустые ячейки только для пустых строк внутри исходной таблицы.

Пример работы первого VBA-кода:

Пустые строки, которые находиться под последними заполненными ячейками не будут выделены. Теперь для удаления выделенных строк пользователю осталось только выбрать инструмент: «ГЛАВНАЯ»-«Ячейки»-«Удалить»-«Удалить строки с листа». Или нажать комбинацию горячих клавиш CTRL+=. А после в появившемся окне «Удаление ячеек» выбрать опцию «строку» и нажать ОК.

Вначале кода присваиваем для переменной diapaz1 диапазон ячеек в границах между A1 и последней используемой ячейкой на рабочем листе Excel.

Примечание. Последняя используемая ячейка на листе — это любая ячейка для, которой были выполнены любые изменения: ввод значений, изменение формата границ или цвета фона и т.п.

Далее в цикле проверяются все строки в этом диапазоне, каждая по отдельности, на количество непустых ячеек. В том случаи если метод CountA возвращает значение 0, то адреса этих ячеек дополняют несмежный диапазон в переменной diapaz2 еще на одну пустую строку.

В конце макроса выделяются все пустые строки, находящиеся внутри диапазона определенным переменной diapaz2. Если же таблица не сдержит ни одной пустой строки, тогда выводиться соответственное сообщение.



Макрос для удаления пустых строк

Как удалить строку макросом? Если нужно сделать так чтобы макрос автоматически не только выделял, но и сам удалял пустые целые и смежные диапазоны ячеек без использования других инструментов, тогда в конце кода для переменной diapaz2.Select следует изменить метод на [Delete]:

diapaz2.[Delete]

Удалить:

Sub DelLine()
  Dim i As Long
  Dim diapaz1 As Range
  Dim diapaz2 As Range
Set diapaz1 = Application.Range(ActiveSheet.Range("A1"), _
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell))
For i = 1 To diapaz1.Rows.Count
If WorksheetFunction.CountA(diapaz1.Rows(i).EntireRow) = 0 Then
If diapaz2 Is Nothing Then
Set diapaz2 = diapaz1.Rows(i).EntireRow
Else
Set diapaz2 = Application.Union(diapaz2, diapaz1.Rows(i).EntireRow)
End If
End If
Next
If diapaz2 Is Nothing Then
MsgBox "Ненайдено ниодной пустой строки!"
Else
diapaz2.[Delete]
End If
End Sub


Пример второго VBA-кода:

Макрос для скрытия пустых строк

Как скрыть пустые строки макросом? Но если вам нужно не удалить, а только скрыть (например, при подготовке документа на печать), тогда эту строку кода следует модифицировать несколько иначе:

diapaz2.EntireRow.Hidden = True

Скрыть:

Sub HidLine()
  Dim i As Long
  Dim diapaz1 As Range
  Dim diapaz2 As Range
Set diapaz1 = Application.Range(ActiveSheet.Range("A1"), _
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell))
For i = 1 To diapaz1.Rows.Count
If WorksheetFunction.CountA(diapaz1.Rows(i).EntireRow) = 0 Then
If diapaz2 Is Nothing Then
Set diapaz2 = diapaz1.Rows(i).EntireRow
Else
Set diapaz2 = Application.Union(diapaz2, diapaz1.Rows(i).EntireRow)
End If
End If
Next
If diapaz2 Is Nothing Then
MsgBox "Ненайдено ниодной пустой строки!"
Else
diapaz2.EntireRow.Hidden = True
End If
End Sub


Пример третьего VBA-кода:

Добавление строк макросом

Как вставить строки макросом? Если мы изменим код в этом же месте как показано ниже, то получиться инструмент для добавления и вставки строк после пустых:

diapaz2.[Insert]

Добавить:

Sub AddLine()
  Dim i As Long
  Dim diapaz1 As Range
  Dim diapaz2 As Range
Set diapaz1 = Application.Range(ActiveSheet.Range("A1"), _
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell))
For i = 1 To diapaz1.Rows.Count
If WorksheetFunction.CountA(diapaz1.Rows(i).EntireRow) = 0 Then
If diapaz2 Is Nothing Then
Set diapaz2 = diapaz1.Rows(i).EntireRow
Else
Set diapaz2 = Application.Union(diapaz2, diapaz1.Rows(i).EntireRow)
End If
End If
Next
If diapaz2 Is Nothing Then
MsgBox "Ненайдено ниодной пустой строки!"
Else
diapaz2.[Insert]
End If
End Sub


Пример четвертого VBA-кода:

Если же вы хотите, чтобы макрос работал исключительно только для пустых строк предварительно выделенного определенного диапазона листа перед запуском макроса, то в начале макроса следует изменить строку создания экземпляра объекта для переменной diapaz1, на:

Set diapaz1 = Selection

Читайте также: Как выделить столбцы в Excel макросом.

Внимание! Следует помнить о том, что если таким образом создавать экземпляр объекта для переменной diapaz1, то тогда нельзя перед запуском макроса выделять все ячейки листа или все ячейки любого столбца. Иначе это затормозит программу Excel, так как один лист содержит аж 1 048 576 строк и тогда они все будут обрабатываться макросом, а пользователь будет ждать.

Your macro does what you intend, but in a very confusing manner.

Whilst running, you’re not actually analysing the currentRow but the currentRow + 1. For something like that I’d prefer a name like baseRow because it implies that other calculations will be done on top of it. In any case, it would be much simpler to just go last-row to first and avoid all the line-numbering messiness.

---

IMO, if you have a macro called RemoveEmptyLines (presumably attached to some descriptively-named Button) then asking the user to confirm that is what they want to do is unnecessary and probably annoying to the User-Experience.

---

I’m also not a fan of using worksheet functions in VBA, especially when used to determine the current state of the worksheet. Excel is notoriously unreliable at maintaining an accurate up-to-date version of things like usedRange, lastCell etc.

If you want to know the final row across all 10,000-odd columns then you’re kinda stuck with it, but I think that’s overkill. If somebody sends you a spreadsheet of data, there should be at least one column somewhere which contains data for every row. Might be names, might be ID/Reference numbers, might be dates etc.

I would structure your sub as a procedure that takes a column reference as an argument, or asks the user to input it, then uses that column for the basis of determining your finalRow.

---

You should also avoid multiple delete actions. It’s fine for small worksheets, but try deleting a row in a worksheet with lots of data and it can take a long time, each time. Instead, I would create a range, name it deleteRange and use Union() to add any new «rows to be deleted» to it. Then, you can have just one delete action at the end of your sub and do it all in one go.

---

Your sub then looks like this:

Option Explicit

Public Sub RemoveEmptyLines()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Dim columnReference As String
    columnReference = InputBox("Please input the Letter-Reference of the key data column")

    Dim columnNumber As Long
    On Error Resume Next '/ Check that it is a valid reference
        columnNumber = Columns(columnReference).Column
    On Error GoTo 0

    If Not columnNumber > 0 Then
        MsgBox "Your column reference was not recognised, please try again"
        Exit Sub
    End If


    Dim lastRow As Long, firstRow As Long, currentRow As Long
    Dim lineIsEmpty As Boolean
    Dim deleteRange As Range
    Dim deleteCount As Long

    last Row = Cells(Rows.Count, columnNumber).End(xlUp).Row

    firstRow = 1
    For currentRow = lastRow To firstRow Step -1 

        lineIsEmpty = (Cells(currentRow, Columns.Count).End(xlToLeft).Column = 1 And IsEmpty(Cells(currentRow, 1)) And IsEmpty(Cells(currentRow, Columns.Count)))

        If lineIsEmpty Then
            If deleteRange Is Nothing Then Set deleteRange = Cells(currentRow, 1) Else Set deleteRange = Union(deleteRange, Cells(currentRow, 1))
            deleteCount = deleteCount + 1
        End If

    Next currentRow

    If Not deleteRange Is Nothing Then deleteRange.EntireRow.Delete

    MsgBox deleteCount & " rows have been deleted.", vbInformation, "Result"

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Succinct, clear, easy to read and understand.