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

与使用VBA的另一个IP范围列相比，如何过滤，复制和删除IP范围

1 个答案: