Sub test()
 nEnd = Cells.SpecialCells(xlCellTypeLastCell).Row

 For i = 1 To nEnd
    Cells(i, 1) = aaa(Cells(i, 1), "jcom")
    Cells(i, 1) = aaa(Cells(i, 1), "docomo")
    Cells(i, 1) = aaa(Cells(i, 1), "softbank")
    Cells(i, 1) = aaa(Cells(i, 1), "biglobe")
    Cells(i, 1) = aaa(Cells(i, 1), "ezweb")
    Cells(i, 1) = aaa(Cells(i, 1), "so-net")
    Cells(i, 1) = aaa(Cells(i, 1), ".ocn.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "nifty")
    Cells(i, 1) = aaa(Cells(i, 1), ".odn.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "gmail.com")
    Cells(i, 1) = aaa(Cells(i, 1), ".dion.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "iij4u")
    Cells(i, 1) = aaa(Cells(i, 1), "hinet.net")
    Cells(i, 1) = aaa(Cells(i, 1), ".email.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".eonet.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".tiki.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "mopera.net")
    Cells(i, 1) = aaa(Cells(i, 1), "vodafone.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".dti.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@ybb.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".pdx.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".sakura.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".plala.or.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@icloud.com")
    Cells(i, 1) = aaa(Cells(i, 1), "@mac.com")
    Cells(i, 1) = aaa(Cells(i, 1), "livedoor.com")
    Cells(i, 1) = aaa(Cells(i, 1), ".wakwak.com")
    Cells(i, 1) = aaa(Cells(i, 1), "@me.com")
    Cells(i, 1) = aaa(Cells(i, 1), ".zaq.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".gyao.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@pdx.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".hi-ho.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@dream.com")
    Cells(i, 1) = aaa(Cells(i, 1), "@outlook.com")
    Cells(i, 1) = aaa(Cells(i, 1), "@aol.com")
    Cells(i, 1) = aaa(Cells(i, 1), "@emobile.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@willcom.com")
    Cells(i, 1) = aaa(Cells(i, 1), "@asahi-net.or.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".gyao.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@googlemail.com")
    Cells(i, 1) = aaa(Cells(i, 1), ".infoweb.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".sannet.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".xrea.com")
    Cells(i, 1) = aaa(Cells(i, 1), ".interq.or.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@yahoo.c.o.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@mail.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@mail.bbexcite.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@e-mail.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@y7mail.com")
    Cells(i, 1) = aaa(Cells(i, 1), "@mail.wbs.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), ".bekkoame.ne.jp")
    Cells(i, 1) = aaa(Cells(i, 1), "@yahoo.com")
    Cells(i, 1) = aaa(Cells(i, 1), "@mbox.co.jp")
 Next

   '空白行削除
    For i = nEnd To 1 Step -1
      If WorksheetFunction.CountA(Rows(i)) = 0 Then
        Rows(i).Delete
      End If
    Next i

End Sub


Function aaa(strText, strFind) As String

    strRet = ""
    If strText <> "" Then
        If InStr(strText, strFind) = 0 Then
            strRet = strText
        End If
    End If
    aaa = strRet
End Function