Страницы: 1
RSS
Макрос удаления сток неправильно работает
 
Добрый вечер, уважаемые формумчане-помощники.

Очень прошу Вашей помощи в исправлении макроса, что оставляет значение "АС", "AS", "NV", "PA" в колонке "G"
а все остальные значения (и пустые) удаляет сроки.

Макрос работает, однако он почему-то оставляет только одно значение "AC", а нужно оставить 4.
Заранее огромное спасибо.
 
 
Код
ElseIf Cells(i, 28).Value <> "OR" And Cells(i, 7).Value <> "AC" Then

вот почему
 
А зачем вам вот этот кусок:    
Код
 ElseIf Cells(i, 28).Value <> "OR" And Cells(i, 7).Value <> "AC" Then
    Rows(i).Delete
без него всё заработает
Соблюдение правил форума не освобождает от модераторского произвола
 
Hugo и buchlotnik спасибо Вам огромное.
С Вашей помощью нашел ошибку

Еще один вопрос: Подскажите пожалуйста. Данный макрос обрабатывает 70000 сток. При обработке "зависает" на 1 час.  Есть ли  возможность еще ускорить данный макрос? Заранее благодарен.
 
Код
Sub ACT()
    Dim rRng As Range
    Dim lr As Long, i As Long

    lr = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lr
        If Cells(i, 7).Value <> "AC" And Cells(i, 7).Value <> "AS" And Cells(i, 7).Value <> "NV" And Cells(i, 7).Value <> "PA" Then
            If rRng Is Nothing Then
                Set rRng = Cells(i, 1)
            Else
                Set rRng = Union(rRng, Cells(i, 1))
            End If
        End If
    Next i
    
    If Not rRng Is Nothing Then
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
            .EnableEvents = False
        End With
        
        rRng.EntireRow.Delete
        Set rRng = Nothing
    
        With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
        End With
    End If
End Sub

Еще немного ускорить:
Код
        If Cells(i, 7).Value <> "AC" Then
            If Cells(i, 7).Value <> "AS" Then
                If Cells(i, 7).Value <> "NV" Then
                    If Cells(i, 7).Value <> "PA" Then
 
Спасибо Вам, vikttur
Сделал макрос "ACTvikttur" однако ошибка ((((
 
Цитата
buchlotnik написал:
Каждому For свой Next
Немного поправим для вашего случая
Каждому If свой End if :)
 
RAN и vikttur спасибо. Исправил End if Но...макрос работает, но без результата (((
 
Цитата
ardsa написал:
Но...макрос работает, но без результата (((
- это смотря на каком файле применять - если на первом, то результат есть :)
Но можно макрос ещё ускорить - считывать данные не из ячеек, а из массива. Или для начала не по 4 раза на каждом шаге смотреть что там в Cells(i, 7), а например всего 1 - тоже будет ускорение.
 
Точно. Постоянно с массивами работаю, а тут не обратил внимания.
 
Профи vikttur и Hugo. Спасибо Вам огромное за советы и совершенствования.
Я использовал первый макрос от vikttur . Результат обработки - около 25 мин !!! Невероятно! Спасибо!
Вы говорите о массивах. Может можно  еще оптимизировать с Вашей помощью(ускорить)? )))
Спасибо Вам.
 
Если таблицу можно сортировать - то думаю лучший результат получите используя макрос от ZVI DelRows:

Но думаю нужно будет его по месту подшаманить - насколько помню по умолчанию там анализируется только только один столбец.
Попробуйте для начала макрос из этой темы ещё разогнать массивами.
И конечно цепочку из AND следует заменить на вложенные IF-THEN, причём с порядком проверки от самого редкого к самому частому.
Изменено: Hugo - 23.06.2019 12:34:03
 
Попробуйте такой вариант.
 
:sceptic:
Код
Sub xx()
    Dim arr, v, r As Range
    With ActiveSheet.UsedRange
        With Intersect([g:g], .Offset(1))
            arr = .Value
            For Each v In Array("AC", "AS", "NV", "PA")
                .Replace v, "=" & v, xlWhole
            Next
            Set r = .SpecialCells(xlCellTypeConstants, 23)
            .Value = arr
            r.EntireRow.Delete
        End With
    End With
End Sub
 
Ой боюсь не влезет UsedRange в arr...
Но красиво :)
Страницы: 1
Наверх