два макроса (скрыть и удалить) колонки с 0

[ignatenko_e]

Здравствуйте!
макросы только начала изучать((( не могу понять почему макрос СКРЫТЬ 0 колонок срабатывает правильно:

Sub скрытьстолб()
Dim r As Range
  Application.ScreenUpdating = False
  For Each r In Range("B23:M23").Columns
    If WorksheetFunction.CountIf(r, ">0") = 0 Then r.EntireColumn.Hidden = True
  Next
  Application.ScreenUpdating = True
End Sub

а если его переделать на УДАЛЕНИЕ 0 колонок, то не все колонки с 0 удаляются:

Sub скрытьстолб()
Dim r As Range
  Application.ScreenUpdating = False
  For Each r In Range("B23:M23").Columns
    If WorksheetFunction.CountIf(r, ">0") = 0 Then r.EntireColumn.Delete
  Next
  Application.ScreenUpdating = True
End Sub

_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор


спасибо

[Serge_Bliznykov]

Сообщение от ignatenko_e

а если его переделать на УДАЛЕНИЕ 0 колонок, то не все колонки с 0 удаляются:

проблема в том, что в цикле изменяется количество обрабатываемых столбцов (и их порядок).
вот смотрите, пусть r - 5-й столбец.
условие WorksheetFunction.CountIf(r, ">0") выполняется,
что происходит с этим столбцом? Верно, он удаляется.
Какой столбец теперь становится 5-м ? 6-й. а 7-й столбец становится 6-м.
А какой столбец в цикле будет обрабатываться следующим? 6-й,
но на месте 6-го стоит 7-й, а 6-й остался на месте 5-го... Его мы пропустили.
и так далее.

Нужно или менять цикл на другой или менять алгоритм обработки.

[Serge_Bliznykov]

Это можно сделать так:

Sub удалитьстолб()
  Dim r As Range, i As Long
  Application.ScreenUpdating = False

  For i = Range("M23").Column To Range("B23").Column Step -1
   Set r = Range(Cells(23, i), Cells(23, i))
   If WorksheetFunction.CountIf(r, ">0") = 0 Then r.EntireColumn.Delete
  Next i
  Application.ScreenUpdating = True
End Sub

или даже так:

Sub удалитьстолб()
  Dim i As Long
  Application.ScreenUpdating = False

  For i = Range("M23").Column To Range("B23").Column Step -1
   If Cells(23, i).Value <= 0 Then Columns(i).EntireColumn.Delete
  Next i
  Application.ScreenUpdating = True
End Sub

[ignatenko_e]

спасибочки))))