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

Question

У меня на самом деле нет большого фона в 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 

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

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 

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

Спасибо!

Answer 1

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

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

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

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 

Update Попробуйте изменить я сделал в случае блока, немного догадки. Посмотрите на это, когда я преуспею.

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

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

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