Excel VBA删除选择退出

时间:2017-12-28 22:08:19

标签: excel vba excel-vba autofilter

我是一名军事招募人员,我正在尝试使用自动过滤器来过滤掉另一个范围内的范围。我从另一个stackoverflow页面得到了这个,但无法弄清楚如何将字符串strSearch更改为123 @ gmail,234 @ gmail,345 @ gmail等范围。

我们获得了潜在客户列表,但我希望保留正在运行的退出列表,并让VBA仔细检查并删除任何具有退出工作表值的单元格。我对VBA很新,但真的很喜欢它。谢谢!

我希望它是strSearch = Sheets(" Opt-Outs")。范​​围(" A:A")以便它获取A中的所有值: A并将它们用作自动过滤器。我相信它需要是一个字符串数组但是如何到达那里我会迷失方向。请帮忙。

Sub optout20171227()
Dim ws As Worksheet
Dim lRow As Long
Dim strSearch As String

'~~> Set this to the relevant worksheet
Set ws = ThisWorkbook.Worksheets("Email Addresses")

'~~> Search Text
strSearch = Sheets("Opt-Outs").Range("A2")

With ws
    '~~> Remove any filters
    .AutoFilterMode = False

    lRow = .Range("A" & .Rows.count).End(xlUp).Row

    With .Range("A1:A" & lRow)
        .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    '~~> Remove any filters
    .AutoFilterMode = False
End With

End Sub

2 个答案:

答案 0 :(得分:0)

应该这样做......

Sub optout20171227()
Dim ws As Worksheet
Dim lRow As Long
Dim strSearch As String
Dim v() As Variant

'~~> Set this to the relevant worksheet
Set ws = ThisWorkbook.Worksheets("Email Addresses")

'~~> Search Text
strSearch = Sheets("Opt-Outs").Range("A2")
v = Application.Transpose(Sheets("Opt-Outs").Range("A:A"))

With ws
    '~~> Remove any filters
    .AutoFilterMode = False

    lRow = .Range("A" & .Rows.count).End(xlUp).Row

    With .Range("A1:A" & lRow)
        .AutoFilter Field:=1, Criteria1:=v
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    '~~> Remove any filters
    .AutoFilterMode = False
End With

答案 1 :(得分:0)

Dim ws As Worksheet
Dim lRow As Long
Dim strSearch As Variant
Dim i As Integer
i = 1

Sheets("Opt-Outs").Select
Range("H2").Value = "Ready"
Range("A2").Select
Do While Range("H2").Value <> Empty


Sheets("Opt-Outs").Select
Range("A2").Select
 Cells(i + 1, 1).Copy
 i = i + 1

 Range("H2").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

If Range("H2").Value = IsBlank Then
Sheets("Email Addresses").Select
Exit Sub
Else

'~~> Set this to the relevant worksheet
Set ws = ThisWorkbook.Worksheets("Email Addresses")

'~~> Search Text
strSearch = Sheets("Opt-Outs").Range("H2")

With ws
    '~~> Remove any filters
    .AutoFilterMode = False

    lRow = .Range("A" & .Rows.count).End(xlUp).Row

    With .Range("A1:A" & lRow)
        .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    '~~> Remove any filters
    .AutoFilterMode = False
End With
End If
Loop