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

Удаление "пустых строк" из диапазона ячеек при помощи макроса

Function DeleteBlankRows(ByVal arr As Variant, ByVal col As Long) As Variant
    ' осуществляет удаление пустых строк из массива
    ' получает в качестве параметров исходный массив, и номер столбца,
    ' по которому определяется, является ли строка постой
    ' возвращает новый массив (с меньшей размерностью по вертикали)
    If Not IsArray(arr) Then MsgBox "Это не массив!", vbCritical: Exit Function
    If col > UBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function
    If col < LBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function
 
    Dim iCount As Long    ' кол-во непустых строк
    For i = LBound(arr) To UBound(arr)
        iCount = iCount - (arr(i, col) <> "")
    Next i
 
    ReDim narr(LBound(arr, 1) To iCount + LBound(arr, 1) - 1, LBound(arr, 2) To UBound(arr, 2))
 
    iCount = LBound(narr)    ' счётчик записей
    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, col) <> "" Then
            For j = LBound(arr, 2) To UBound(arr, 2)
                narr(iCount, j) = arr(i, j)
            Next j
            iCount = iCount + 1
        End If
    Next i
 
    DeleteBlankRows = narr
End Function

Sub ПримерИспользования()
    On Error Resume Next
    arr = [a1:d15] ' считываем значения ячеек диапазона [a1:d15] в массив arr
    
    ' получаем массив arr2, в 5-м столбце которого нет пустых значений
    arr2 = DeleteBlankRows(arr, 5)
 
    [f1:z111].Clear ' очищаем диапазон ячеек [f1:z111] на листе
    
    ' вставляем массив без пустых строк обратно на лист
    [f1].Resize(UBound(arr2, 1), UBound(arr2, 2)).Value = arr2
End Sub

Вложения:

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

спасибо!

Немного изменил Вашу функцию. Теперь можно удалять не только "пустые".
Function DeleteBlankRows(ByVal arr As Variant, ByVal col As Long, ByVal pr As Variant) As Variant
' осуществляет удаление строк из массива
' получает в качестве параметров исходный массив, и номер столбца,
' по которому определяется, наличие параметра pr в строке
' возвращает новый массив (с меньшей размерностью по вертикали)
If Not IsArray(arr) Then MsgBox "Это не массив!", vbCritical: Exit Function
If col > UBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function
If col < LBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function

Dim iCount As Long '
For i = LBound(arr) To UBound(arr)
iCount = iCount - (arr(i, col) <> pr)
Next i

ReDim narr(LBound(arr, 1) To iCount + LBound(arr, 1) - 1, LBound(arr, 2) To UBound(arr, 2))

iCount = LBound(narr) ' счётчик записей
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, col) <> pr Then
For j = LBound(arr, 2) To UBound(arr, 2)
narr(iCount, j) = arr(i, j)
Next j
iCount = iCount + 1
End If
Next i

DeleteBlankRows = narr
End Function

пример использования
Arr2 = DeleteBlankRows(arr, 8, 1)
Arr2 = DeleteBlankRows(arr, 11, 0)
Arr2 = DeleteBlankRows(arr, 3, "")
Arr2 = DeleteBlankRows(arr, 10, "удалить")

Отличный пример, спасибо! Долго искал подобный макрос, буду прикручивать к своему файлу. Вы Человечище с большой буквы)

Огромное спасибо! Привинтил. Работает отлично. Хотелось бы всерьёз разобраться с обработкой виртуальных массивов. Ваш макрос, мой первый шажок в этом направлении

вот бы то же самое, но со столбцами

Спасибо. То, что я искала.

Удаление пустых строк это хорошо, но уже Мир просит удаление строк/стоблцов на листе/книге. Вот это сейчас дейстаительно интересно.
Просим...

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _   ___   _____   _       _        
(_) |_ _| |___ | | | / | __ __
| | | | / / | | | | \ \/ /
| | | | / / | |___ | | > <
|_| |___| /_/ |_____| |_| /_/\_\
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.