如何使用vba过滤，复制和删除IP范围，与另一个ip范围列进行比较

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