Удалить строки на основе ряда условий (множественное число) - PullRequest
1 голос
/ 26 марта 2019

Прошло много времени с тех пор, как я использовал VBA.У меня есть ряд уникальных значений, которые я хотел бы найти в таблице.И если эти значения существуют в указанной таблице, удалите всю строку.

Я могу выполнить цикл и удалить определенные, единичные значения, но борюсь с несколькими.Я попытался заменить «30ExGEPAc30Q4» (код ниже) на Range () и массив, но не могу его получить.Вот что у меня так далеко:

Sub test()

Dim x As Long
Dim lastrow As Long

lastrow = Sheets("LRP").ListObjects("Data_LRP").Range.Rows.Count

Worksheets("LRP").Activate
    For x = lastrow To 1 Step -1
        If Cells(x, 1).Value = "30ExGEPAc30Q4" Then
            Rows(x).Delete
        End If
    Next x
End Sub

Ответы [ 2 ]

0 голосов
/ 26 марта 2019

Для любопытных все закончилось тем, что выглядело так.Спасибо за помощь!

Sub Cull()

Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht1row As Long
Dim sht2row As Long
Dim sht2total As Long
Dim DupID As String

Set sht1 = Worksheets("Data Form")
Set sht2 = Worksheets("LRP")
sht2.Activate
sht2total = Worksheets("LRP").ListObjects("Data_LRP").Range.Rows.Count
sht1row = 33

Do While sht1.Cells(sht1row, 2).Value <> ""

DupID = sht1.Cells(sht1row, 2).Value

    For sht2row = 2 To sht2total

        If DupID = Cells(sht2row, 1).Value Then

            Rows(sht2row).Delete
            sht2row = sht2row - 1
            Exit For

        End If

    Next

    sht1row = sht1row + 1

Loop

End Sub
0 голосов
/ 26 марта 2019

Если я вас правильно понимаю, это то, чего вы пытаетесь достичь; Я убрал некоторые ненужные биты, и теперь вам просто нужно отредактировать x и lastrow, как необходимо.

Sub test()

Dim x As Long
Dim lastrow As Long

'lastrow = Sheets("LRP").ListObjects("Data_LRP").Range.Rows.Count
x = 1
lastrow = 21


'Worksheets("LRP").Activate
Do While x <= lastrow
'    For x = lastrow To 1 Step -1
        If Cells(x, 1).Value = "30ExGEPAc30Q4" Then
            Rows(x).Delete
            lastrow = lastrow - 1
        Else
            x = x + 1
        End If
'    Next x

Loop
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...