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

Вход

Регистрация

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

 

= Мир MS Excel/Цикл на удаление строк в умной таблице с условием - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Цикл на удаление строк в умной таблице с условием (Макросы/Sub)
Цикл на удаление строк в умной таблице с условием
Raven2009 Дата: Воскресенье, 15.12.2019, 18:03 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день.

Есть файл, где на листе Аномалии есть умная таблица. На другом листе кнопка.

Я написал цикл и повесил на кнопку, который удаляет все строчки, где встречается Недостача... Но что-то явно упустил, после цикла 1 строка остается нетронутой... Что там поправить нужно, подскажите?
К сообщению приложен файл: test1.xlsb (31.2 Kb)
 
Ответить
СообщениеДобрый день.

Есть файл, где на листе Аномалии есть умная таблица. На другом листе кнопка.

Я написал цикл и повесил на кнопку, который удаляет все строчки, где встречается Недостача... Но что-то явно упустил, после цикла 1 строка остается нетронутой... Что там поправить нужно, подскажите?

Автор - Raven2009
Дата добавления - 15.12.2019 в 18:03
RAN Дата: Воскресенье, 15.12.2019, 18:37 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
Sub qq()
    Dim i&
    With Worksheets("$Аномалии").ListObjects(1).ListColumns("Тип аномалии")
        For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
            If Worksheets("$Аномалии").Cells(i, .Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .Column).Delete
        Next
    End With
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Воскресенье, 15.12.2019, 18:48
 
Ответить
Сообщение[vba]
Код
Sub qq()
    Dim i&
    With Worksheets("$Аномалии").ListObjects(1).ListColumns("Тип аномалии")
        For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
            If Worksheets("$Аномалии").Cells(i, .Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .Column).Delete
        Next
    End With
End Sub
[/vba]

Автор - RAN
Дата добавления - 15.12.2019 в 18:37
Raven2009 Дата: Воскресенье, 15.12.2019, 19:08 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо вам большое)) Значит через Do... Loop, который я писал на кнопку, нельзя сделать?
 
Ответить
СообщениеСпасибо вам большое)) Значит через Do... Loop, который я писал на кнопку, нельзя сделать?

Автор - Raven2009
Дата добавления - 15.12.2019 в 19:08
RAN Дата: Воскресенье, 15.12.2019, 19:33 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Да почему нельзя? Но мне лень.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеДа почему нельзя? Но мне лень.

Автор - RAN
Дата добавления - 15.12.2019 в 19:33
Raven2009 Дата: Воскресенье, 15.12.2019, 19:41 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Да почему нельзя?


Кстати выдает ошибку на вашем коде в строке, где For... Объект не поддерживает метод или что-то вроде этого...

Но мне лень.


На кнопке цикл уже написан был, но там что-то поправить нужно (возможно 1 строчку).
 
Ответить
Сообщение
Да почему нельзя?


Кстати выдает ошибку на вашем коде в строке, где For... Объект не поддерживает метод или что-то вроде этого...

Но мне лень.


На кнопке цикл уже написан был, но там что-то поправить нужно (возможно 1 строчку).

Автор - Raven2009
Дата добавления - 15.12.2019 в 19:41
RAN Дата: Воскресенье, 15.12.2019, 20:08 | Сообщение № 6
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Зря я занялся улучшайзингом. :(
В 2х экземплярах
[vba]
Код
Sub qq()
    Dim i&
    With Worksheets("$Аномалии").ListObjects(1)
        For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
            If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
        Next
    End With
End Sub
Sub ww()
    Dim i&
    With Worksheets("$Аномалии").ListObjects(1)
        i = .Range.Row + .ListRows.Count
        Do While i > .Range.Row
            If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
            i = i - 1
            DoEvents ' для возможности прерывания кода в случае ошибки
        Loop
    End With
End Sub
[/vba]

Цикл на удаление строк всегда идет снизу вверх, иначе неизбежны (или преодолимы весьма сложными плясками с бубном) ошибки.

.ListColumns("Тип аномалии").Range.Column можно заменить на 6 :)


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеЗря я занялся улучшайзингом. :(
В 2х экземплярах
[vba]
Код
Sub qq()
    Dim i&
    With Worksheets("$Аномалии").ListObjects(1)
        For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
            If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
        Next
    End With
End Sub
Sub ww()
    Dim i&
    With Worksheets("$Аномалии").ListObjects(1)
        i = .Range.Row + .ListRows.Count
        Do While i > .Range.Row
            If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
            i = i - 1
            DoEvents ' для возможности прерывания кода в случае ошибки
        Loop
    End With
End Sub
[/vba]

Цикл на удаление строк всегда идет снизу вверх, иначе неизбежны (или преодолимы весьма сложными плясками с бубном) ошибки.

.ListColumns("Тип аномалии").Range.Column можно заменить на 6 :)

Автор - RAN
Дата добавления - 15.12.2019 в 20:08
Kuzmich Дата: Воскресенье, 15.12.2019, 20:13 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
Кстати выдает ошибку на вашем коде в строке, где For... Объект не поддерживает метод или что-то вроде этого...


Там нужно строку
[vba]
Код
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
[/vba]
уместить либо в одну строку, либо
[vba]
Код
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then
   Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
End If
[/vba]
 
Ответить
Сообщение
Цитата
Кстати выдает ошибку на вашем коде в строке, где For... Объект не поддерживает метод или что-то вроде этого...


Там нужно строку
[vba]
Код
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
[/vba]
уместить либо в одну строку, либо
[vba]
Код
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then
   Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
End If
[/vba]

Автор - Kuzmich
Дата добавления - 15.12.2019 в 20:13
Raven2009 Дата: Воскресенье, 15.12.2019, 20:19 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Там нужно строку


Ошибка возникает на строке, которая начинается с For i...

Насчет if я понимаю))

Может получится все-таки посмотреть вариант с Do Until... Loop? Мне интересно понять, что я не так написал там? 1 строка остается не удаленной...
 
Ответить
Сообщение
Там нужно строку


Ошибка возникает на строке, которая начинается с For i...

Насчет if я понимаю))

Может получится все-таки посмотреть вариант с Do Until... Loop? Мне интересно понять, что я не так написал там? 1 строка остается не удаленной...

Автор - Raven2009
Дата добавления - 15.12.2019 в 20:19
RAN Дата: Воскресенье, 15.12.2019, 20:21 | Сообщение № 9
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Kuzmich, проблема не в этом.
Почему-то, при улучшайзинге, у меня код продолжил работать даже после того, как я туда вклинил 2 ошибки


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеKuzmich, проблема не в этом.
Почему-то, при улучшайзинге, у меня код продолжил работать даже после того, как я туда вклинил 2 ошибки

Автор - RAN
Дата добавления - 15.12.2019 в 20:21
Kuzmich Дата: Воскресенье, 15.12.2019, 20:23 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
У меня конвертер не берет файл test1.xlsb,
поэтому посмотреть не могу.
 
Ответить
СообщениеУ меня конвертер не берет файл test1.xlsb,
поэтому посмотреть не могу.

Автор - Kuzmich
Дата добавления - 15.12.2019 в 20:23
RAN Дата: Воскресенье, 15.12.2019, 20:25 | Сообщение № 11
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
что я не так написал там?

Дык я вроде написал, что?
Kuzmich,
[vba]
Код
Sub ClearAnomaly()

Dim l As Long, iRowCount As Long
Set ShAnom = ThisWorkbook.Worksheets("$Аномалии")
Set AnomObj = ShAnom.ListObjects("tAnomaly")

    l = 1
Do Until IsEmpty(AnomObj.DataBodyRange.Cells(l, 1))
   If AnomObj.Range.Cells(l, 6) = "Недостача" Then
        AnomObj.Range.Delete
    End If
   l = l + 1
Loop

ActiveWorkbook.Save

End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
что я не так написал там?

Дык я вроде написал, что?
Kuzmich,
[vba]
Код
Sub ClearAnomaly()

Dim l As Long, iRowCount As Long
Set ShAnom = ThisWorkbook.Worksheets("$Аномалии")
Set AnomObj = ShAnom.ListObjects("tAnomaly")

    l = 1
Do Until IsEmpty(AnomObj.DataBodyRange.Cells(l, 1))
   If AnomObj.Range.Cells(l, 6) = "Недостача" Then
        AnomObj.Range.Delete
    End If
   l = l + 1
Loop

ActiveWorkbook.Save

End Sub
[/vba]

Автор - RAN
Дата добавления - 15.12.2019 в 20:25
bmv98rus Дата: Воскресенье, 15.12.2019, 20:27 | Сообщение № 12
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4099
Репутация: 766 ±
Замечаний: 0% ±

Excel 2013/2016
Raven2009, боротся с недосдачей лучше всего отфильтровав, удалить :-)
[vba]
Код
    With Sheets("$Аномалии").ListObjects("tAnomaly").Range
        .AutoFilter Field:=6, Criteria1:= _
        "Недостача"
       .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete Shift:=xlUp
        .AutoFilter Field:=6
    End With
[/vba]


Замечательный Временно просто медведь , процентов на 20.
 
Ответить
СообщениеRaven2009, боротся с недосдачей лучше всего отфильтровав, удалить :-)
[vba]
Код
    With Sheets("$Аномалии").ListObjects("tAnomaly").Range
        .AutoFilter Field:=6, Criteria1:= _
        "Недостача"
       .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete Shift:=xlUp
        .AutoFilter Field:=6
    End With
[/vba]

Автор - bmv98rus
Дата добавления - 15.12.2019 в 20:27
Raven2009 Дата: Понедельник, 16.12.2019, 09:37 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
отфильтровав


здравствуйте. Код на 1 раз. В первый раз удаляются недостачи, во второй раз все остальное, в третий раз - выдает ошибку...

Я с автофильтром не очень знаком, что-то наверно не так...
 
Ответить
Сообщение
отфильтровав


здравствуйте. Код на 1 раз. В первый раз удаляются недостачи, во второй раз все остальное, в третий раз - выдает ошибку...

Я с автофильтром не очень знаком, что-то наверно не так...

Автор - Raven2009
Дата добавления - 16.12.2019 в 09:37
Raven2009 Дата: Понедельник, 16.12.2019, 10:31 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
у меня код продолжил работать даже после того


Что то не работают ваши экземпляры у меня... Строки с недостачами не удаляются...
К сообщению приложен файл: test1.xlsm (34.6 Kb)
 
Ответить
Сообщение
у меня код продолжил работать даже после того


Что то не работают ваши экземпляры у меня... Строки с недостачами не удаляются...

Автор - Raven2009
Дата добавления - 16.12.2019 в 10:31
RAN Дата: Понедельник, 16.12.2019, 10:45 | Сообщение № 15
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Ну слепой я, и считать плохо умею. А самостоятельно посчитать, что столбец Е пятый, а не шестой не судьба?
Или вообще оставить как было с определением номера столбца по названию? А то в одном месте сменили, в другом нет.

[p.s.]Поглядел старый файл. Оказывается это не я плохо считать умею, это у кого-то ручки шаловливые.[/p.s.]


Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Понедельник, 16.12.2019, 10:59
 
Ответить
СообщениеНу слепой я, и считать плохо умею. А самостоятельно посчитать, что столбец Е пятый, а не шестой не судьба?
Или вообще оставить как было с определением номера столбца по названию? А то в одном месте сменили, в другом нет.

[p.s.]Поглядел старый файл. Оказывается это не я плохо считать умею, это у кого-то ручки шаловливые.[/p.s.]

Автор - RAN
Дата добавления - 16.12.2019 в 10:45
Raven2009 Дата: Понедельник, 16.12.2019, 11:03 | Сообщение № 16
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Или вообще оставить как было с определением номера столбца по названию?


Таким способом кстати говоря удаляется сам столбец. Прально, нет столбца - нет проблемы)))

Да и вообще он удаляется. Что цифра там, что ссылка на название...


Сообщение отредактировал Raven2009 - Понедельник, 16.12.2019, 11:09
 
Ответить
Сообщение
Или вообще оставить как было с определением номера столбца по названию?


Таким способом кстати говоря удаляется сам столбец. Прально, нет столбца - нет проблемы)))

Да и вообще он удаляется. Что цифра там, что ссылка на название...

Автор - Raven2009
Дата добавления - 16.12.2019 в 11:03
RAN Дата: Понедельник, 16.12.2019, 11:09 | Сообщение № 17
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Таким способом кстати говоря удаляется сам столбец

Покажите это чудо.


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Таким способом кстати говоря удаляется сам столбец

Покажите это чудо.

Автор - RAN
Дата добавления - 16.12.2019 в 11:09
Raven2009 Дата: Понедельник, 16.12.2019, 11:21 | Сообщение № 18
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Интересно это чудо работает. То удаляет столбец вообще, то и правильно удаляет строчки с недостачами.

Покажите это чудо.


каким образом? видео снять? Вот файл после последнего удаления столбца.
К сообщению приложен файл: 8987635.xlsm (33.5 Kb)
 
Ответить
СообщениеИнтересно это чудо работает. То удаляет столбец вообще, то и правильно удаляет строчки с недостачами.

Покажите это чудо.


каким образом? видео снять? Вот файл после последнего удаления столбца.

Автор - Raven2009
Дата добавления - 16.12.2019 в 11:21
китин Дата: Понедельник, 16.12.2019, 11:29 | Сообщение № 19
Группа: Модераторы
Ранг: Экселист
Сообщений: 7013
Репутация: 1073 ±
Замечаний: 0% ±

Excel 2007;2010;2016
моя попыточка

[vba]
Код
Sub ttt()
Dim tt_&, i_&
   With Sheets("$Аномалии")
    tt_ = .Cells(Rows.Count, 1).End(xlUp).Row
        For i_ = tt_ To 2 Step -1
         If .Cells(i_, 5).Value = "Недостача" Then
          .Rows(i_).Delete
         End If
         
        Next i_
   End With
End Sub
[/vba]
К сообщению приложен файл: test1-1-.xlsm (25.9 Kb)


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852
 
Ответить
Сообщениемоя попыточка

[vba]
Код
Sub ttt()
Dim tt_&, i_&
   With Sheets("$Аномалии")
    tt_ = .Cells(Rows.Count, 1).End(xlUp).Row
        For i_ = tt_ To 2 Step -1
         If .Cells(i_, 5).Value = "Недостача" Then
          .Rows(i_).Delete
         End If
         
        Next i_
   End With
End Sub
[/vba]

Автор - китин
Дата добавления - 16.12.2019 в 11:29
RAN Дата: Понедельник, 16.12.2019, 11:38 | Сообщение № 20
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Ну не зря же таблицу "умной" называют. Вот она и умничает. :D
Измените строку удаления
[vba]
Код
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then .ListRows(i - .Range.Row).Delete
[/vba]

[p.s.]Если все сплошь недостача, и ее нужно удалить - то зачем столбец? hands [/p.s.]


Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Понедельник, 16.12.2019, 11:40
 
Ответить
СообщениеНу не зря же таблицу "умной" называют. Вот она и умничает. :D
Измените строку удаления
[vba]
Код
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then .ListRows(i - .Range.Row).Delete
[/vba]

[p.s.]Если все сплошь недостача, и ее нужно удалить - то зачем столбец? hands [/p.s.]

Автор - RAN
Дата добавления - 16.12.2019 в 11:38
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Цикл на удаление строк в умной таблице с условием (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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