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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос строк по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос строк по условию (Макросы/Sub)
Перенос строк по условию
Netsky Дата: Среда, 18.01.2017, 09:55 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Добрый день, пользуюсь макросом на перенос строк по условию, но обнаружил ошибку. Ошибка заключается в следующем, при отсутствии данных на любом из листов (Выгрузка, Добавка, Мини) с которых требуется сделать перенос, макрос выдает ошибку. В примере данные присутствую на всех 3 листах, для того чтобы увидеть ошибку необходимо удалить числовые значения с любого из листов (Выгрузка, Добавка, Мини)
Как можно исправить код чтобы при отсутствии данных на листе он просто пропускал его и приступал к следующему.
Пример прикрепил, в нем рабочий макрос.
К сообщению приложен файл: 7629545.xlsm (46.8 Kb)


Сообщение отредактировал Netsky - Среда, 18.01.2017, 09:57
 
Ответить
СообщениеДобрый день, пользуюсь макросом на перенос строк по условию, но обнаружил ошибку. Ошибка заключается в следующем, при отсутствии данных на любом из листов (Выгрузка, Добавка, Мини) с которых требуется сделать перенос, макрос выдает ошибку. В примере данные присутствую на всех 3 листах, для того чтобы увидеть ошибку необходимо удалить числовые значения с любого из листов (Выгрузка, Добавка, Мини)
Как можно исправить код чтобы при отсутствии данных на листе он просто пропускал его и приступал к следующему.
Пример прикрепил, в нем рабочий макрос.
Автор - Netsky
Дата добавления - 18.01.2017 в 09:55
sboy Дата: Среда, 18.01.2017, 10:24 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Можно пропускать ошибку
[vba]
Код
Sub Макрос20()
Worksheets("Вырезанные").Activate
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim i As Long
    For Each Sht In Worksheets
      If Sht.Name = "Выгрузка" Or Sht.Name = "Добавка" Or Sht.Name = "Мини" Then
      On Error Resume Next
        With Sht
          iLastRow = Cells(Rows.Count, "K").End(xlUp).Row + 1
          .Range("A1").CurrentRegion.AutoFilter 11, ">0", xlAnd, "<50000"
          .AutoFilter.Range.Offset(1).SpecialCells(12).Copy Cells(iLastRow, 1)
          .AutoFilter.Range.Offset(1).SpecialCells(12).EntireRow.Delete
          .AutoFilter.Range.AutoFilter
         End With
      End If
    Next
End Sub
[/vba]

Яндекс: 410016850021169
 
Ответить
СообщениеДобрый день.
Можно пропускать ошибку
[vba]
Код
Sub Макрос20()
Worksheets("Вырезанные").Activate
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim i As Long
    For Each Sht In Worksheets
      If Sht.Name = "Выгрузка" Or Sht.Name = "Добавка" Or Sht.Name = "Мини" Then
      On Error Resume Next
        With Sht
          iLastRow = Cells(Rows.Count, "K").End(xlUp).Row + 1
          .Range("A1").CurrentRegion.AutoFilter 11, ">0", xlAnd, "<50000"
          .AutoFilter.Range.Offset(1).SpecialCells(12).Copy Cells(iLastRow, 1)
          .AutoFilter.Range.Offset(1).SpecialCells(12).EntireRow.Delete
          .AutoFilter.Range.AutoFilter
         End With
      End If
    Next
End Sub
[/vba]
Автор - sboy
Дата добавления - 18.01.2017 в 10:24
sboy Дата: Среда, 18.01.2017, 10:27 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Или проверять по вашей переменной iLastRow

upd: неправильно.

Яндекс: 410016850021169

Сообщение отредактировал sboy - Среда, 18.01.2017, 10:32
 
Ответить
СообщениеИли проверять по вашей переменной iLastRow

upd: неправильно.
Автор - sboy
Дата добавления - 18.01.2017 в 10:27
Netsky Дата: Среда, 18.01.2017, 10:33 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Цитата sboy, 18.01.2017 в 10:24, в сообщении № 2 ()
Добрый день.
Можно пропускать ошибку

Данный вариант для меня более предпочтителен, спасибо за помощь!
 
Ответить
Сообщение
Цитата sboy, 18.01.2017 в 10:24, в сообщении № 2 ()
Добрый день.
Можно пропускать ошибку

Данный вариант для меня более предпочтителен, спасибо за помощь!
Автор - Netsky
Дата добавления - 18.01.2017 в 10:33
SLAVICK Дата: Среда, 18.01.2017, 10:37 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
еще вариант проверки к-ва заполненных ячеек:
[vba]
Код
Sub Макрос20()
Worksheets("Вырезанные").Activate
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim i As Long

    For Each Sht In Worksheets
      If Sht.Name = "Выгрузка" Or Sht.Name = "Добавка" Or Sht.Name = "Мини" Then
        With Sht
         If Application.CountA(.Range("A1").CurrentRegion) > 1 Then
            iLastRow = Cells(Rows.Count, "K").End(xlUp).Row + 1
            .Range("A1").CurrentRegion.AutoFilter 11, ">0", xlAnd, "<50000"
            .AutoFilter.Range.Offset(1).SpecialCells(12).Copy Cells(iLastRow, 1)
            .AutoFilter.Range.Offset(1).SpecialCells(12).EntireRow.Delete
            .AutoFilter.Range.AutoFilter
          End If
         End With
      End If
    Next
End Sub
[/vba]

Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщениееще вариант проверки к-ва заполненных ячеек:
[vba]
Код
Sub Макрос20()
Worksheets("Вырезанные").Activate
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim i As Long

    For Each Sht In Worksheets
      If Sht.Name = "Выгрузка" Or Sht.Name = "Добавка" Or Sht.Name = "Мини" Then
        With Sht
         If Application.CountA(.Range("A1").CurrentRegion) > 1 Then
            iLastRow = Cells(Rows.Count, "K").End(xlUp).Row + 1
            .Range("A1").CurrentRegion.AutoFilter 11, ">0", xlAnd, "<50000"
            .AutoFilter.Range.Offset(1).SpecialCells(12).Copy Cells(iLastRow, 1)
            .AutoFilter.Range.Offset(1).SpecialCells(12).EntireRow.Delete
            .AutoFilter.Range.AutoFilter
          End If
         End With
      End If
    Next
End Sub
[/vba]
Автор - SLAVICK
Дата добавления - 18.01.2017 в 10:37
Netsky Дата: Среда, 18.01.2017, 10:48 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 1 ±
Замечаний: 0% ±

Excel 2013
Проверил с большой таблицей, оба варианта работают как и должны. Спасибо вам!
 
Ответить
СообщениеПроверил с большой таблицей, оба варианта работают как и должны. Спасибо вам!
Автор - Netsky
Дата добавления - 18.01.2017 в 10:48
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос строк по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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