オプトアウトを削除するExcel VBA

Question

私は軍の募集者で、オートフィルタを使用して別の範囲の範囲をフィルタリングしようとしています。私は別のstackoverflowページからこれを取得しましたが、文字列strSearchを123 @ gmail、234 @ gmail、345 @ gmailなどの範囲に変更する方法を見つけることができません。

私はリードのリストを取得しますが、オプトアウトの実行リストを保持し、オプトアウトワークシートの値を持つセルをVBAでダブルチェックして削除するようにしてください。私はVBAの初心者ですが、本当に楽しんでいます。ありがとうございました！

strSearch = Sheets（ "Opt-Outs"）Range（ "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の

Answer 1

これはそれを行う必要があります...

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 

Answer 2

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