VBA: Как использовать оператор like для списка значений? - PullRequest
Новая
       18

VBA: Как использовать оператор like для списка значений?

2 голосов
/ 13 марта 2019

Вот часть моего кода.Есть ли способ сделать это простым?Спасибо. 

For i = 2 To ws.Range("E1").CurrentRegion.Rows.Count

If ws.Cells(i, 4).Value Like ("*SSI*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*Settlement instruction*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*delivery Instruction*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*Request form*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.cells(i, 4).Value Like ("*Sales to onboarding*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*Application*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*Doc Check list*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*Prime to Credit*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*Prime to Legal*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*Prime_Legal*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*Prime_Credit*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*LEXIS*") Then ws.Cells(i, 4).EntireRow.Delete
If ws.Cells(i, 4).Value Like ("*Withdrawal Request*") Then ws.Cells(i, 4).EntireRow.Delete

Next i

Ответы [ 4 ]

2 голосов
/ 13 марта 2019

Существует множество способов сделать это, но вот один из них:

Во-первых, при удалении строк всегда начинайте с нижней части диапазона и двигайтесь вверх - это предотвращает пропуск строк при удалении.

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

Dim tmpAr As Variant
Dim test As Variant

Set ws = ActiveSheet
tmpAr = Split("SSI,Settlement instruction,delivery Instruction,Request form,Sales to onboarding,Application,Doc Check list,Prime to Credit,Prime to Legal,Prime_Legal,Prime_Credit,LEXIS,Withdrawal Request", ",")
For i = ws.Range("E1").CurrentRegion.Rows.Count To 2 Step -1
    For Each test In tmpAr
        If ws.Cells(i, 4).Value Like "*" & test & "*" Then
            ws.Cells(i, 4).EntireRow.Delete
            Exit For
        End If
    Next
Next i
1 голос
/ 13 марта 2019
  1. запустить цикл назад
  2. избегать пересчетов
  3. удалить только один раз 


For i = ws.Range("E1").CurrentRegion.Rows.Count To 2 Step -1
    DR = False
    Set r = ws.Cells(i, 4)
    s = r.Value
    If s Like ("*SSI*") Then DR = True
    If s Like ("*Settlement instruction*") Then DR = True
    If s Like ("*delivery Instruction*") Then DR = True
    If s Like ("*Request form*") Then DR = True
    If s Like ("*Sales to onboarding*") Then DR = True
    If s Like ("*Application*") Then DR = True
    If s Like ("*Doc Check list*") Then DR = True
    If s Like ("*Prime to Credit*") Then DR = True
    If s Like ("*Prime to Legal*") Then DR = True
    If s Like ("*Prime_Legal*") Then DR = True
    If s Like ("*Prime_Credit*") Then DR = True
    If s Like ("*LEXIS*") Then DR = True
    If s Like ("*Withdrawal Request*") Then DR = True
    If DR Then ws.Cells(i, 4).EntireRow.Delete
Next i
1 голос
/ 13 марта 2019

Обратите внимание:

  1. Когда строка удаляется, ячейки смещаются вверх, поэтому строка ниже будет эффективно иметь тот же номер строки, поэтому я использовал цикл do вместо i = i - 1 после удаления строки / e: да, я мог бы использовать шаг -1 или напиши по-другому, но хотел показать что-то отличное от других ответов
  2. Нет необходимости использовать оператор like, он не поддерживается в VBS, поэтому, если вы когда-нибудь решите изучать VBS, рекомендуется избегать его

Вот мой подход, вы можете добавлять новые ключевые слова в массив или создавать коллекцию: 

MyArr = Array("SSI", "Settlement instruction", "delivery Instruction", "Request form", "Sales to onboarding", "Application", "Doc Check list", "Prime to Credit", "Prime to Legal", "Prime_Legal", "Prime_Credit", "LEXIS", "Withdrawal Request")

LastRow = ws.Range("E1").CurrentRegion.Rows.count
i = 1
Do Until i > LastRow
    i = i + 1
    cVal = ws.Cells(i, 4).Value
    For Each ma In MyArr
        If InStr(1, cVal, ma) > 0 Then
            ws.Cells(i, 4).EntireRow.Delete
            i = i - 1 'cells below will shift up, so next row will have the same row number
            Exit For
        End If
    Next
Loop
1 голос
/ 13 марта 2019

Вы можете попробовать что-то в этом роде 

Sub del()

Dim a As Variant
Dim s As Variant
Dim r As Range
Dim l As Long

a = Array("*abc*", "*def*", "efg*", "abcdef*hi")
Set r = Range("a1:a20")

For l = r.Rows.Count To 1 Step -1

    For Each s In a
        If r.Cells(l, 1).Value Like s Then
                Rows(l).EntireRow.Delete
                Exit For
        End If
    Next s

Next l

End Sub
...