Удаление "пустых строк" из диапазона ячеек при помощи макроса
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, "удалить")
Отличный пример, спасибо! Долго искал подобный макрос, буду прикручивать к своему файлу. Вы Человечище с большой буквы)
Огромное спасибо! Привинтил. Работает отлично. Хотелось бы всерьёз разобраться с обработкой виртуальных массивов. Ваш макрос, мой первый шажок в этом направлении
вот бы то же самое, но со столбцами
Спасибо. То, что я искала.
Удаление пустых строк это хорошо, но уже Мир просит удаление строк/стоблцов на листе/книге. Вот это сейчас дейстаительно интересно.
Просим...
Отправить комментарий