Здравствуйте. Всех с прошедшими праздниками. Здесь на форуме мне делали макрос, который в 2018 году отлично работал. Но в 2019 году он дал сбой. Видимо в печатную форму внесли изменение и теперь макрос удаляет нужные мне строки. Приложен пример. Мне надо удалить все заголовки (кроме первого) и соединить 2 макроса в один. Первый мне удалял все заголовки, второй удалял все пустые строки. Помогите пожалуйста. В примере то, что в желтой заливке макрос удалил, чего не надо делать.
Макрос 1. [vba]
Код
Sub Удалить_заголовки()
Dim arr(), lr As Long, i As Long
Application.ScreenUpdating = False lr = Cells(Rows.Count, "A").End(xlUp).Row arr() = Range("A1:A" & lr).Value For i = UBound(arr) To 13 Step -1 If arr(i, 1) = "Дата операции" Then Rows(i - 1).Resize(4).Delete End If Next i Application.ScreenUpdating = True MsgBox "Готово!", vbInformation
End Sub
[/vba]
Макрос 2 [vba]
Код
Sub DeleteEmptyRows() LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count 'определяем размеры таблицы Application.ScreenUpdating = False For r = LastRow To 1 Step -1 'проходим от последней строки до первой If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete 'если в строке пусто - удаляем ее Next r End Sub
[/vba]
Здравствуйте. Всех с прошедшими праздниками. Здесь на форуме мне делали макрос, который в 2018 году отлично работал. Но в 2019 году он дал сбой. Видимо в печатную форму внесли изменение и теперь макрос удаляет нужные мне строки. Приложен пример. Мне надо удалить все заголовки (кроме первого) и соединить 2 макроса в один. Первый мне удалял все заголовки, второй удалял все пустые строки. Помогите пожалуйста. В примере то, что в желтой заливке макрос удалил, чего не надо делать.
Макрос 1. [vba]
Код
Sub Удалить_заголовки()
Dim arr(), lr As Long, i As Long
Application.ScreenUpdating = False lr = Cells(Rows.Count, "A").End(xlUp).Row arr() = Range("A1:A" & lr).Value For i = UBound(arr) To 13 Step -1 If arr(i, 1) = "Дата операции" Then Rows(i - 1).Resize(4).Delete End If Next i Application.ScreenUpdating = True MsgBox "Готово!", vbInformation
End Sub
[/vba]
Макрос 2 [vba]
Код
Sub DeleteEmptyRows() LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count 'определяем размеры таблицы Application.ScreenUpdating = False For r = LastRow To 1 Step -1 'проходим от последней строки до первой If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete 'если в строке пусто - удаляем ее Next r End Sub
Sub Удалить_заголовки_и_пустые() Dim Addr$ With ActiveSheet.UsedRange.Columns("A") Addr = "=" & .Resize(1).Offset(.Cells.Count).Address(, , Application.ReferenceStyle, 1) With Intersect(.Cells, .Offset(12)) .Replace "Дата операции", Addr .Replace 1, Addr, xlWhole .Replace Empty, Addr End With End With Evaluate(Addr).DirectDependents.EntireRow.Delete xlUp End Sub
[/vba]
Здравствуйте. [vba]
Код
Sub Удалить_заголовки_и_пустые() Dim Addr$ With ActiveSheet.UsedRange.Columns("A") Addr = "=" & .Resize(1).Offset(.Cells.Count).Address(, , Application.ReferenceStyle, 1) With Intersect(.Cells, .Offset(12)) .Replace "Дата операции", Addr .Replace 1, Addr, xlWhole .Replace Empty, Addr End With End With Evaluate(Addr).DirectDependents.EntireRow.Delete xlUp End Sub
Ошибочка. Пустые удаляются с ошибкой. Пустая считается строка, если в ней вообще нет данных. Можно это как то поправить? Все что в синей заливке нельзя удалять. Удалите из макроса модуль по удалению пустых строк. Я нашел предыдущий файл. Там было 2 пустые строки перед "датой операции". Как было раньше приложен файл 2228933
Ошибочка. Пустые удаляются с ошибкой. Пустая считается строка, если в ней вообще нет данных. Можно это как то поправить? Все что в синей заливке нельзя удалять. Удалите из макроса модуль по удалению пустых строк. Я нашел предыдущий файл. Там было 2 пустые строки перед "датой операции". Как было раньше приложен файл 2228933Mark1976
Sub Удалить_заголовки_и_пустые() Dim Addr$ With ActiveSheet.UsedRange.Columns("A") Addr = "=" & .Resize(1).Offset(.Cells.Count).Address(, , Application.ReferenceStyle, 1) With Intersect(.Cells, .Offset(12)) .Replace "Дата операции", Addr .Replace 1, Addr, xlWhole .Replace Empty, Addr End With End With Evaluate(Addr).DirectDependents.EntireRow.Delete xlUp End Sub
[/vba]
Pelena, в этом макросе [vba]
Код
Sub Удалить_заголовки_и_пустые() Dim Addr$ With ActiveSheet.UsedRange.Columns("A") Addr = "=" & .Resize(1).Offset(.Cells.Count).Address(, , Application.ReferenceStyle, 1) With Intersect(.Cells, .Offset(12)) .Replace "Дата операции", Addr .Replace 1, Addr, xlWhole .Replace Empty, Addr End With End With Evaluate(Addr).DirectDependents.EntireRow.Delete xlUp End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
