Неправильно удаляет....Selection.Delete Shift:=xlUp

[sonata]

Неправильно работает блок else,
Количество значений без else,содержащих словосочетание *оконч*
определяется правильно,я их выделяю цветом, а потом, если значение ячейки не содержит такого сочетания-хочу удалить такие строки, но происходит совсем не то, что я ожидаю...,может быть моя ошибка кроется в неправильном понимании строки: Selection.Delete Shift:=xlUp?

Код: Выделить всё

Public Sub jkl1()
Dim i As Integer
' Прогруммулька для очистки прочих взносов и оставления только
' тех, где произведен окончательный расчет...
j = 0
For i = 1 To 2000
If (Cells(i, 2).Value Like "*оконч*") Then
    j = j + 1
    Rows(i).Select
    Selection.Font.ColorIndex = 3
   
    Else
    Rows(i).Select
        Selection.Delete Shift:=xlUp
End If
Next i
MsgBox (j)
End Sub

[GSerg]

А что же, что же происходит вместо ожидаемого?

[sonata]

В итоге получилось то, что мне надо,но цикл получается бесконечным...,можно ли с этим что-нибудь поделать?

А про j, Вы намекаете, что пожсчет можно вести с помощью i?

[GSerg]

Подсчёт вести с помощью i нельзя... А вот цикл сдуть можно. Надо только его немного переорганизовать...

Код: Выделить всё

For each c in Cells(1,2).currentregion
  If c.Value Like "*оконч*" Then
      j = j + 1
      c.entirerow.Font.ColorIndex = 3
  Else
      c.entirerow.Delete Shift:=xlUp
  End If
Next


[sonata]

Как я поняла суть цикла в том, что увеличение счетчика идет только в блоке If, поэтому через обычный цикл, так нельзя и нужно только через For Each
А жаль, For Each работает гораздо медленнее....
Похоже проблема не нова- и выход только один?

[RayShade]

Внутри любого цикла нельзя можифицировать переменную, им управляющую.

Делать надо так: в цикле по рядам, находим индексы тех, которые надо удалить и кладем их в массив или коллекцию. И потом вторым циклом пробегаемся по этому массиву\коллекции и спокойно удаляем все ряды, индексы которых там записаны.

[sonata]

3 вопроса:
1)Возникает ошибка "Subscript out of range"
2)Можно ли в одной процедуре использовать 2 цикла с одинаковым именем счетчика- i
3)Правильно ли я поняла суть самой идеи?

Код: Выделить всё

Public Sub jkl2()
Dim i As Integer
Dim massiv1()
' Прогруммулька для очистки прочих взносов и оставления только
' тех, где произведен окончательный расчет...
For i = 1 To 900
If (Not Cells(i, 2).Value Like "*конч*") Then
        massiv1(i) = i
        Else
        massiv1(i) = 0
End If
Next i
For i = 1 To 900
        If (massiv1(i) <> 0) Then
        Rows(i).Select
        Selection.Delete Shift:=xlUp
        End If
Next i
End Sub

[RayShade]

Хм.. я бы Selection.Delete Shift:=xlUp вынес за пределы цикла. То есть сперва все выделил а потом удалил.

По поводу счетчиов - да, можно.

[sonata]

Но на первый вопрос так и не ответил....

[RayShade]

Потому что не указано на какой строке она возникает

[sonata]

Здесь...
massiv1(i) = i

[RayShade]

Ну правильно! Массив то у тебя объявлен как пустой. Лучше используй коллекцию и просто добавляй в нее типа coll.add i

[sonata]

1.Нужно тогда объявить массив как
Dim massiv1(900) ?
2.А как использовать коллекции?

[RayShade]

1. Либо так, либо делать ему перед добавлением каждого нового элемента redim(massiv, ubound(massiv)+1) но это как бы медленно будет.

2. Очень просто. Объявляем коллекцию как dim coll as new colleciton

доюбавляем в нее элементы как coll.add "something" и потом читаем их оттуда как coll.item(i) и все.

[corgi]

кто сказал что нельзя изменять переменные внутри циклов Почему мне не сообщили а то я все время .......
я бы например сделал вот так

Код: Выделить всё

Public Sub jkl1()
Dim i As Integer
' Прогруммулька для очистки прочих взносов и оставления только
' тех, где произведен окончательный расчет...
For i = 1 To 2000
If (Cells(i, 2).Value Like "*оконч*") Then
    Rows(i).Select
    Selection.Font.ColorIndex = 3
Else
    Rows(i).Select
    Selection.Delete Shift:=xlUp
    i = i - 1
End If
Next i
End Sub


только вот лучше for заменить на
do while
loop
чтобы действительно не нарваться на бесконечный цикл и вобще более грамотно

[GSerg]

Ой, люди, сорьте, простегал чуточку со своим кодом, потому он и медленный стал.
Во-первых, надо перебирать, понятное дело, строки, а я стал перебирать ячейки.
Во-вторых, почему никто (и я тоже) не вспомнил о вещи. которая сильно ускоряет подобные процедурки?

Код: Выделить всё

dim c as range, j as long
Application.screenupdating=false
For each c in Cells(1,2).currentregion.Rows
  If c.cells(1,2).Value Like "*оконч*" Then
     j = j + 1
     c.Font.ColorIndex = 3
  Else
     c.Delete Shift:=xlUp
  End If
Next
Application.screenupdating=true