Невозможно удалить ячейки, если они содержат значение VBA

Question

У меня есть файл с кучей ячеек в столбце A (1500), который выглядит следующим образом:

Perfect Imperfection;"Kevin Gates";"Luca Brasi 2: Gangsta Grillz";1

или

Perfect Imperfection;"Kevin Gates";"Luca Brasi 2: Gangsta Grillz";0

Я пытаюсь удалить ячейки, оканчивающиеся на ;1

Обратите внимание, что в некоторых названиях песен есть 1, а другие имеют вид:Perfect Imperfection;;;1

Я использую следующий код из другого поста переполнения стека, который я немного отредактировал:

Sub DeleteRowsWithX()

maxRow = ActiveSheet.UsedRange.Rows.Count
MsgBox (maxRow)
For i = 1 To maxRow
    Do While (StrComp(ActiveSheet.Cells(i, 1).Text, ";1", vbTextCompare) = 0)
        Rows(i).Select
        Selection.Delete Shift:=xlUp
        MsgBox ("Deleted")
   Loop
Next

End Sub

Если это поможет, вот несколько примеров файла:

Perfect Imperfection;"Kevin Gates";"Luca Brasi 2: Gangsta Grillz";1
Perfect Strangers;"Lil Wayne";"Tha Carter V";1
Perplexing Pegasus;"Rae Sremmurd";;1
Phone Numbers Wiz Khalifa;;;0
Piano Man;"Billy Joel";;1
Picasso Baby Jay Z;;;0
Pick Up the Phone ft Young Thug Travis Scott;;;0
Picture;"Kid Rock";;1
Pillowtalk  Conor Maynard;;;1
Pimp Juice;Nelly;Nellyville;1
Pinball Wizard;"The Who";;1
Pink Toes  Childish Gambino;;;1

Что должно выглядеть так:

Phone Numbers Wiz Khalifa;;;0
Picasso Baby Jay Z;;;0
Pick Up the Phone ft Young Thug Travis Scott;;;0

Однако ничего не удаляется.Кто-нибудь может посоветовать?ПРИМЕЧАНИЕ - это не нужно делать в VBA, я просто хочу удалить строки, заканчивающиеся на 1

Answer 1

Требования: Удалить всю строку значений в столбце 1, заканчивающуюся "; 1"

Для этого типа требований предложите использовать AutoFilter и SpecialCells для удалениявсе целевые строки одновременно.

Попробуйте:

 Sub AutoFilter_To_DeleteRows()
    With ActiveSheet
        Application.Goto .Cells(1), 1
        Rem Add a temporary header to avoid indiscriminate deletion of the first row.
        .Cells(1).EntireRow.Insert
        .Cells(1).Value2 = "Temporary Header"
        Rem Filter values ending with ";1"
        .Columns(1).AutoFilter Field:=1, Criteria1:="=*;1"
        Rem Delete all resulting rows
        .Columns(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    End Sub

Answer 2

Держите ответ близко к коду, который вы написали.

Вам нужно пройтись от нижней части списка к вершине.Таким образом, когда строки удаляются, вы не пропускаете строки.Это можно сделать в цикле For , начав с нижней части списка и двигаясь назад к первой строке, используя Шаг -1 .

Правую функцию можно использовать для проверки последних двух символов значения ячейки, чтобы увидеть, соответствуют ли они ; 1 .

Do Хотя может бытьудалены.

MsgBox были расширены, чтобы предоставить больше деталей при тестировании.Их можно закомментировать, если вы довольны тем, как работает код.

Sub DeleteRowsWithX()

maxRow = ActiveSheet.UsedRange.Rows.Count
MsgBox "No. of Rows: " & maxRow

    For i = maxRow To 1 Step -1
        ValOfCell = ActiveSheet.Cells(i, 1).Value2
            If Right(ValOfCell, 2) = ";1" Then
                Rows(i).Delete Shift:=xlUp
                MsgBox "Row: " & i & vbCrLf & "Value: " & ValOfCell & vbCrLf & "has been deleted."
            End If
    Next

End Sub

Answer 3

Джерри, я не смог заставить StrComp работать так, как я хотел, поэтому я использовал Mid & Len , чтобы выполнить то, что вам нужно.Это будет работать, так как все названия песен заканчиваются на «;?».Кроме того, я не добавил к коду, но рассмотрите возможность сделать все возможное, чтобы не использовать метод Select - это может привести к осложнениям.

Sub DeleteRowsWithX()

Dim maxrow As Integer
Dim i As Integer
maxrow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To maxrow
    Do While Mid(Cells(i, 1).Text, Len(Cells(i, 1).Text) - 1, 2) = ";1"
        Rows(i).Select
        Selection.Delete Shift:=xlUp
        MsgBox ("Deleted")
   Loop
Next

End Sub