VBA Удаление строк на основе значения из нескольких столбцов

Question

Каждое утро мне нужно отфильтровать телефонные номера из экспорта. Мне нужно отфильтровать документ Excel и удалить строки, в которых правильно заполнен номер телефона. Документ выглядит так:

The rows need to be deleted when:

1. When COM_Soort is not G or T
2. When Landcode is not NL, BE or Empty.
3. COM_SOORT = G, Landcode = NL, Waarde starts with 06 and is 10 numbers long (Does not contain strange characters and such.)
4. COM_SOORT = T, Landcode = NL, Waarde starts with 0, does not start with 06 and is 10 numbers long (Does not contain strange characters and such.)
5. COM_SOORT = G, Landcode = BE, Waarde starts with 04 and is 10 numbers long (Does not contain strange characters and such.)
6. COM_SOORT = T, Landcode = BE, Waarde starts with 0, does not start with 04 and is 9 numbers long (Does not contain strange characters and such.)

введите описание изображения здесь

Я пытаюсь создать макрос с VBA, который автоматизирует этот процесс. Я делаю это впервые, так что терпите меня. В настоящее время я застрял со следующим:

1. Мне нужно запустить код как разные макросы, иначе он удаляет только столбцы, а затем просто останавливается, без ошибок et c.
2. Я не знаю, как реализовать, что он проверяет, содержит ли 'Waarde' что-то еще, кроме чисел
3. Я не знаю, как реализовать это, когда 'Waarde' начинается с 0, его нужно удалить, кроме случаев, когда он начинается с 06 или 04, в зависимости от значения COM_SOORT и Landcode.

Option Explicit

Sub DeleteColumns()
    
    Dim Unused As Range
    Set Unused = Range("A:H,K:K")
    Unused.Delete
        
End Sub


Sub DeleteComSoort()

    Dim LastRow As Long
    Dim rowNum As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For rowNum = LastRow To 1 Step -1
        If Range("B" & rowNum).Value <> "G" And Range("B" & rowNum).Value <> "T" Then Rows(rowNum).Delete
    Next rowNum

End Sub

Sub DeleteLandCode()

    Dim LastRow As Long
    Dim rowNum As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For rowNum = LastRow To 1 Step -1
        If Range("C" & rowNum).Value <> "NL" And Range("C" & rowNum).Value <> "BE" And Range("C" & rowNum).Value <> "a" Then Rows(rowNum).Delete
    Next rowNum

End Sub

Sub DeleteRow()

    Dim LastRow As Long
    Dim rowNum As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For rowNum = LastRow To 1 Step -1
        If Range("B" & rowNum).Value = "G" And Range("C" & rowNum).Value = "NL" And Len(Range("D" & rowNum).Value) = 10 And Range("D" & rowNum).Value Like "06*" Then
            Rows(rowNum).Delete
        ElseIf Range("B" & rowNum).Value = "G" And Range("C" & rowNum).Value = "BE" And Len(Range("D" & rowNum).Value) = 10 And Range("D" & rowNum).Value Like "04*" Then
            Rows(rowNum).Delete
        ElseIf Range("B" & rowNum).Value = "T" And Range("C" & rowNum).Value = "NL" And Len(Range("D" & rowNum).Value) = 10 And Range("D" & rowNum).Value Like "0*" Then
            Rows(rowNum).Delete
        ElseIf Range("B" & rowNum).Value = "T" And Range("C" & rowNum).Value = "BE" And Len(Range("D" & rowNum).Value) = 9 And Range("D" & rowNum).Value Like "0*" Then
            Rows(rowNum).Delete
        End If
    Next rowNum

End Sub

Надеюсь, вы, ребята, можете мне помочь.

Answer 1

Попробуйте следующий код, пожалуйста. Это должно быть очень быстро для большого размера диапазона, удаляя все строки сразу:

Sub DeleteRowsAccCriteria()
 Dim sh As Worksheet, lastRow As Long, i As Long, rngDel As Range, boolDel As Boolean, Unused As Range

 Set sh = ActiveSheet 'use here your sheet
   Set Unused = sh.Range("A:H,K:K")
   Unused.Delete

 lastRow = sh.Range("A" & Rows.count).End(xlUp).Row
 
 sh.UsedRange.Columns(1).Interior.Color = xlNone 'for testing period, to clean the green cells interior
 For i = 2 To lastRow
    If sh.Range("B" & i).Value <> "G" And sh.Range("B" & i).Value <> "T" Then
        boolDel = True
    ElseIf sh.Range("C" & i).Value <> "NL" And _
            sh.Range("C" & i).Value <> "BE" And _
            Not IsEmpty(sh.Range("C" & i).Value) Then
        boolDel = True
    ElseIf sh.Range("B" & i).Value = "T" And _
           sh.Range("C" & i).Value = "NL" And _
           left(sh.Range("D" & i).Value, 1) = "0" And _
           left(sh.Range("D" & i).Value, 2) <> "06" And _
           Len(sh.Range("D" & i).Value) = 10 And _
           sh.Range("D" & i).Value Like "##########" Then
        boolDel = True
    ElseIf sh.Range("B" & i).Value = "G" And _
           sh.Range("C" & i).Value = "NL" And _
           left(sh.Range("D" & i).Value, 2) = "06" And _
           Len(sh.Range("D" & i).Value) = 10 And _
           sh.Range("D" & i).Value Like "##########" Then
        boolDel = True
    ElseIf sh.Range("B" & i).Value = "G" And _
           sh.Range("C" & i).Value = "BE" And _
           left(sh.Range("D" & i).Value, 2) = "04" And _
           Len(sh.Range("D" & i).Value) = 10 And _
           sh.Range("D" & i).Value Like "##########" Then
        boolDel = True
    ElseIf sh.Range("B" & i).Value = "T" And _
           sh.Range("C" & i).Value = "BE" And _
           left(sh.Range("D" & i).Value, 1) = "0" And _
           left(sh.Range("D" & i).Value, 2) <> "04" And _
           Len(sh.Range("D" & i).Value) = 9 And _
           sh.Range("D" & i).Value Like "#########" Then
        boolDel = True
    End If
    If boolDel Then
        If rngDel Is Nothing Then
            Set rngDel = sh.Range("A" & i)
        Else
            Set rngDel = Union(rngDel, sh.Range("A" & i))
        End If
    End If
    boolDel = False
 Next
 If Not rngDel Is Nothing Then
    'rngDel.EntireRow.Delete xlUp
    rngDel.Interior.Color = vbGreen
 End If
End Sub

Приведенный выше код делает только внутреннюю часть ячеек в A: зеленым цветом для строки, которая будет удалена. Это только на период тестирования . Если все пойдет хорошо, вы должны только не комментировать строку rngDel.EntireRow.Delete xlUp и прокомментировать / удалить следующую (rngDel.Interior.Color = vbGreen) и sh.UsedRange.Columns(1).Interior.Color = xlNone.