Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос стал удалять не те строки. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос стал удалять не те строки. (Макросы/Sub)
Макрос стал удалять не те строки.
Mark1976 Дата: Суббота, 12.01.2019, 06:23 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 560
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте. Всех с прошедшими праздниками. Здесь на форуме мне делали макрос, который в 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]
К сообщению приложен файл: ____.xlsb(82.8 Kb)


Сообщение отредактировал Mark1976 - Суббота, 12.01.2019, 06:26
 
Ответить
СообщениеЗдравствуйте. Всех с прошедшими праздниками. Здесь на форуме мне делали макрос, который в 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]

Автор - Mark1976
Дата добавления - 12.01.2019 в 06:23
krosav4ig Дата: Суббота, 12.01.2019, 07:30 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2080
Репутация: 871 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
[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
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте.
[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
[/vba]

Автор - krosav4ig
Дата добавления - 12.01.2019 в 07:30
Mark1976 Дата: Суббота, 12.01.2019, 07:50 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 560
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
krosav4ig, спасибо. Скажите в чем была проблема? У меня просто файлов от 2018 года не осталось, сравнить не смогу.


Сообщение отредактировал Mark1976 - Суббота, 12.01.2019, 07:53
 
Ответить
Сообщениеkrosav4ig, спасибо. Скажите в чем была проблема? У меня просто файлов от 2018 года не осталось, сравнить не смогу.

Автор - Mark1976
Дата добавления - 12.01.2019 в 07:50
Pelena Дата: Суббота, 12.01.2019, 10:27 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 14094
Репутация: 3081 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
в чем была проблема?

Видимо, раньше перед заголовками была пустая строка, а теперь её нет. Поэтому строчку [vba]
Код
Rows(i - 1).Resize(4).Delete
[/vba]надо было переписать так [vba]
Код
Rows(i).Resize(3).Delete
[/vba]


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщение
в чем была проблема?

Видимо, раньше перед заголовками была пустая строка, а теперь её нет. Поэтому строчку [vba]
Код
Rows(i - 1).Resize(4).Delete
[/vba]надо было переписать так [vba]
Код
Rows(i).Resize(3).Delete
[/vba]

Автор - Pelena
Дата добавления - 12.01.2019 в 10:27
Mark1976 Дата: Суббота, 12.01.2019, 10:34 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 560
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Pelena, понял спасибо.
 
Ответить
СообщениеPelena, понял спасибо.

Автор - Mark1976
Дата добавления - 12.01.2019 в 10:34
Mark1976 Дата: Суббота, 12.01.2019, 15:12 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 560
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Ошибочка. Пустые удаляются с ошибкой. Пустая считается строка, если в ней вообще нет данных. Можно это как то поправить? Все что в синей заливке нельзя удалять. Удалите из макроса модуль по удалению пустых строк. Я нашел предыдущий файл. Там было 2 пустые строки перед "датой операции". Как было раньше приложен файл 2228933
К сообщению приложен файл: 123.xlsb(82.8 Kb) · 2228933.xlsb(49.3 Kb)


Сообщение отредактировал Mark1976 - Суббота, 12.01.2019, 15:47
 
Ответить
СообщениеОшибочка. Пустые удаляются с ошибкой. Пустая считается строка, если в ней вообще нет данных. Можно это как то поправить? Все что в синей заливке нельзя удалять. Удалите из макроса модуль по удалению пустых строк. Я нашел предыдущий файл. Там было 2 пустые строки перед "датой операции". Как было раньше приложен файл 2228933

Автор - Mark1976
Дата добавления - 12.01.2019 в 15:12
Pelena Дата: Суббота, 12.01.2019, 17:18 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 14094
Репутация: 3081 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
В Ваших файлах нет макросов


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеВ Ваших файлах нет макросов

Автор - Pelena
Дата добавления - 12.01.2019 в 17:18
Mark1976 Дата: Суббота, 12.01.2019, 17:24 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 560
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
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
[/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
[/vba]

Автор - Mark1976
Дата добавления - 12.01.2019 в 17:24
krosav4ig Дата: Суббота, 12.01.2019, 18:13 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 2080
Репутация: 871 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Mark1976, уберите строку [vba]
Код
.Replace Empty, Addr
[/vba] и будет вам счастье


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеMark1976, уберите строку [vba]
Код
.Replace Empty, Addr
[/vba] и будет вам счастье

Автор - krosav4ig
Дата добавления - 12.01.2019 в 18:13
Mark1976 Дата: Воскресенье, 13.01.2019, 08:38 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 560
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
krosav4ig, спасибо
 
Ответить
Сообщениеkrosav4ig, спасибо

Автор - Mark1976
Дата добавления - 13.01.2019 в 08:38
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос стал удалять не те строки. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!