Удалить строку под конкретным текстом - PullRequest
0 голосов
/ 13 декабря 2018

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

Sub DeleteRowWithContentsGuidelines()
    Dim c As Range
    Dim SrchRng
    Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
    Do
        Set c = SrchRng.Find("Chart only", LookIn:=xlValues)
        If Not c Is Nothing Then c.EntireRow.Delete
    Loop While Not c Is Nothing
End Sub

В строке выше удаляется строка, в которой есть «Только диаграмма», но яхочу удалить строку ниже, но не точную строку.это возможно?

Ответы [ 2 ]

0 голосов
/ 13 декабря 2018
Sub DeleteRowWithContentsGuidelines()
    Dim c As Range, rDel As Range, i As Long
    Dim SrchRng As Range, s1 As String

    Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A" & Rows.Count).End(xlUp))
    s1 = "Chart only"

    With SrchRng
        Set c = .Cells(1)
        For i = 1 To WorksheetFunction.CountIf(.Cells, s1)
            Set c = .Find(What:=s1, After:=c, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
            If Not c Is Nothing Then
                If rDel Is Nothing Then
                    Set rDel = c.Offset(1)
                Else
                    Set rDel = Union(rDel, c.Offset(1))
                End If
            End If
        Next i
        rDel.EntireRow.Delete
    End With
End Sub
0 голосов
/ 13 декабря 2018

.Find возвращает объект диапазона, поэтому вы можете просто использовать что-то вроде следующего, чтобы удалить строку под найденным текстом:

Sub DeleteRowWithContentsGuidelines()
    Dim c As Range
    Dim SrchRng
    Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A" & Activesheet.Rows.Count).End(xlUp))
    Set c = SrchRng.Find("Chart only", LookIn:=xlValues)
    If c is Nothing then Exit Sub
    dim firstAddress : firstAddress = c.Address
    Do
        If Not c Is Nothing Then c.Offset(1, 0).EntireRow.Delete
        Set c = SrchRng.FindNext(c)
        If c is Nothing then Exit Sub
    Loop While c.Address <> firstAddress
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...