Макрос VBA для удаления непроверенных строк с помощью проверки Марлетта

У меня действительно мало опыта в VBA, но я пытаюсь создать макрос, в котором при нажатии кнопки удаляются все строки, в которых нет галочки в определенном диапазоне. Я просмотрел несколько форумов и узнал о проверке «marlett», где символ «a» в этом шрифте отображается как галочка. Вот код, который я должен генерировать автоматически при нажатии на ячейку в столбце A в соответствующем диапазоне:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("A10:A111")) Is Nothing Then
            Target.Font.Name = "Marlett"
                If Target = vbNullString Then
                    Target = "a"
                Else
                    Target = vbNullString
                End If
        End If

End Sub

Затем у меня есть другой макрос (назначенный кнопке), который фактически удаляет строки без галочки в столбце «A» при нажатии кнопки:

Sub delete_rows()

Dim c As Range

On Error Resume Next
For Each c in Range("A10:A111")
    If c.Value <> "a" Then
        c.EntireRow.Delete
    End If
Next c

End Sub

Все работает, но единственная проблема в том, что мне нужно нажать кнопку несколько раз, прежде чем все непроверенные строки будут удалены !! Кажется, что мой цикл не работает должным образом - может ли кто-нибудь помочь ??

Спасибо!


person hillmandj    schedule 05.04.2013    source источник


Ответы (1)


Я думаю, это может быть связано с тем, как вы удаляете строки, вы можете пропускать строку после каждого удаления.

Возможно, вы захотите изменить свой for-each на обычный цикл for. так что вы можете контролировать индекс, над которым работаете. см. этот ответ или другие ответы на вопрос, чтобы узнать, как это сделать.

Вот модифицированная версия, которая должна удовлетворить вашу (возможную) проблему.

Sub Main()
    Dim Row As Long
    Dim Sheet As Worksheet
    Row = 10
    Set Sheet = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    Do
        If Sheet.Cells(Row, 1).Value = "a" Then
            'Sheet.Rows(Row).Delete xlShiftUp
            Row = Row + 1
        Else
            'Row = Row + 1
            Sheet.Rows(Row).Delete xlShiftUp
        End If
    Loop While Row <= 111
    Application.ScreenUpdating = True
End Sub

Обновление Попробуйте отредактировать блок if, которое я внес, - немного догадываюсь. Посмотрю, когда у меня будет excel.

Он заходит в бесконечный цикл независимо от предложенного изменения. Проблема заключалась в том, что когда он приближался к концу ваших данных, он постоянно находил пустые строки (поскольку данных больше нет!), Поэтому он продолжал их удалять.

Однако приведенный ниже код должен работать.

Sub Main()
    Dim Row As Long: Row = 10
    Dim Count As Long: Count = 0
    Dim Sheet As Worksheet
    Set Sheet = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    Do
        If Sheet.Cells(Row, 1).Value = "a" Then
            Row = Row + 1
        Else
            Count = Count + 1
            Sheet.Rows(Row).Delete xlShiftUp
        End If
    Loop While Row <= 111 And Row + Count <= 111
    Application.ScreenUpdating = True
End Sub
person NickSlash    schedule 05.04.2013
comment
хрм, почему-то, когда я использую ваш код и переназначаю на кнопку, ничего не удаляется ... не знаю почему :( - person hillmandj; 05.04.2013
comment
Ваш лист называется Sheet1? в противном случае вам нужно будет изменить мой код, чтобы отразить ваше имя листа, иначе я не уверен. - person NickSlash; 05.04.2013
comment
это, скорее всего, проблема. У меня нет доступа к таблице до завтра, но я дам ответ, если это действительно проблема. Спасибо! - person hillmandj; 07.04.2013
comment
Итак, я изменил имя листа на соответствующее имя, а также изменил код, чтобы сделать то, что он должен был сделать, удалить НЕПРОВЕРЕННЫЕ строки, установив If Sheet.Cells (Row, 1) .Value ‹› a Then ... Однако, Я думаю, что это нарушает ваш код или превращает его в непрерывный цикл, так как при этом происходит сбой excel. Есть идеи, почему? - person hillmandj; 08.04.2013