Как отфильтровать, скопировать и удалить диапазон IP-адресов в сравнении с другим столбцом диапазона IP-адресов с помощью vba

Question

Заранее спасибо.

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

Я хочу настроить автоматическую фильтрацию Marco для сравнения со списком диапазона ipaddress (более 50 из них), скопировать результаты на новый лист и удалить все строки, которые были отфильтрованы на исходном листе., оставляя другой ipaddress и другие элементы строки нетронутыми.

Используя запись marco, я могу фильтровать и копировать только два диапазона ipaddress.Примеры ipaddress могут быть 10.61.22. * Или 10.1. *.Любой ip-адрес, который существует с IP, будет сопоставлен, скопирован, скопирован на новый лист и затем удален.

Хотелось бы проверить, могу ли я создать массив для этого или для Marco / vba, чтобы сравнить с другим столбцом и отфильтровать нужные мне IP-адреса.

код Automarco, как показано ниже

Sub IP()    
'    
' IP Macro    
'    
    Columns("H:H").Select    
    Application.CutCopyMode = False   
    Selection.AutoFilter

    ActiveSheet.Range("$H$1:$H$52509").AutoFilter Field:=1, Criteria1:= _    
        "=10.61.22*", Operator:=xlOr, Criteria2:="=10.1.**"

    Cells.Select   
    Selection.Copy  
    Sheets("Sheet2").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

    Sheets("Sheet1").Select   
    Range("A2:L2").Select    
    Range(Selection, Selection.End(xlDown)).Select    
    Application.CutCopyMode = False    
    Selection.EntireRow.Delete    
    ActiveSheet.ShowAllData
End Sub

Answer 1

Это должно работать. Очевидно, вы можете добавить больше фильтров массива. Приватная функция была кругом о способе получения последнего члена на место. Есть лучшие способы сделать это, но это должно сработать

Sub IP()

Dim f_List(50) As String 'or whatever is your maximum
Dim aWS As Worksheet
Set aWS = ActiveSheet

f_List(0) = "=10.1.*"
f_List(1) = "=10.61.22*"
f_List(2) = "=10.123"
f_List(3) = "=10.2*"
'etc


Dim i As Long

For i = 0 To UBound(f_List)
    If f_List(i) <> "" Then

     Intersect(aWS.UsedRange, aWS.Columns("H:H")).AutoFilter Field:=1, Criteria1:=f_List(i)

            Range("h2:h999999").SpecialCells(xlCellTypeVisible).Copy ThePlaceToPaste

            Range("h2:h999999").SpecialCells(xlCellTypeVisible).EntireRow.Delete
            aWS.Columns("H:H").AutoFilter

    End If


Next i

End Sub

Private Function ThePlaceToPaste() As Range
Const SNAME As String = "Sheet1"
Const theColumnToPaste = "A"

Dim WS As Worksheet
Set WS = Sheets(SNAME) 'you should probably call it something else

Set ThePlaceToPaste = WS.Range(theColumnToPaste & "1")
Dim z As Long


Do
'this is sort of a weird way to get last row, not sure if you're filtering or what, but it should work.
z = Application.WorksheetFunction.CountA(Range(ThePlaceToPaste, WS.Cells(Rows.Count, Range(theColumnToPaste & "1").Column)))

Set ThePlaceToPaste = ThePlaceToPaste.Offset(z, 0)

Loop Until z = 0

End Function