Excel宏可以在一列中搜索多个网址

Question

我有一个包含27列的工作表（Sheet2），第一行是A-Z的列标题和总共27列的NUM。每列都有一个很长的受限URL列表，这些列表按列的字母排序，最后一列（第27列）用于以数字开头的URL。列的长度在300-600,000个细胞之间。

我一直在寻找的是一个宏脚本，它将检查col A Sheet1中所有新添加的URL，以确定它们是否存在于Sheet2中，从而导致标记每个URL“已存在”或“要添加” ，像：

Sheet 1中

Col(A)          Col(B)
badsite1.com    already exist
badsite2.com    already exist
badsite3.com    to be added
badsite4.con    to be added
badsite5.com    already exist

因此，在网上运行该网址的另一项测试后，“要添加”网址将被添加到Sheet2。

令人惊讶的是，我发现了以下脚本（错过了它的源代码），它正是我在应用一些小修改之后所做的：

Sub x()

Dim rFind As Range, sFind As Range, sAddr As String, ws As Worksheet, rng As Range, ms     As Worksheet
Application.ScreenUpdating = 0
Set ws = Sheets("Sheet2")
Set ms = Sheets("Sheet1")
ms.Range("B2:B" & Rows.Count).ClearContents
Set rng = ms.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

For Each sFind In rng
    With ws.UsedRange
        Set rFind = .Find(sFind, .Cells(.Cells.Count), xlValues, xlPart)
        If Not rFind Is Nothing Then
            sAddr = rFind.Address
            Do
                sFind.Offset(, 1) = rFind.Address
                sFind.Font.Color = -16776961
                Set rFind = .FindNext(rFind)
            Loop While rFind.Address <> sAddr
            sAddr = ""
            Else
            sFind.Offset(, 1) = "No Found"
            sFind.Offset(, 1).Font.Color = -16776961
        End If
    End With
Next
Set ms = Nothing
Set ws = Nothing
Set rng = Nothing
Set rFind = Nothing
Application.ScreenUpdating = True
End Sub 

使用一小部分网址（例如5-10）运行此脚本非常棒。 Sheet2中的Sheet1 col-A和HUGE列表中的列表较长，就像我的一样，这个脚本是一个“乌龟”，花了一个多小时来查看167个URL的列表！

此脚本可以修改为“兔子”吗？ :)

非常感谢在这方面提供的任何援助。

像往常一样..提前谢谢。

Answer 1

试试这个 - 在Excel 2010中测试：

Sub x()

Dim rFind As Range, sFind As Range, sAddr As String, ws As Worksheet
Dim rng As Range, ms As Worksheet, s As String
Application.ScreenUpdating = False
'stop calculation
Application.Calculation = xlCalculationManual
Set ws = Sheets("Sheet2")
Set ms = Sheets("Sheet1")
ms.Range("B2:B" & ms.Rows.Count).ClearContents
ms.Range("A2:B" & ms.Rows.Count).Font.Color = 0
Set rng = ms.Range("A2:A" & ms.Cells(ms.Rows.Count, 1).End(xlUp).Row)

For Each sFind In rng
    'get first character of url
    s = Left(sFind, 1)
    'resort to column aa if not a a to z
    If Asc(UCase(s)) < 65 Or Asc(UCase(s)) > 90 Then s = "AA"
    'only look in appropriate column
    Set rFind = ws.Columns(s).Find(sFind, , xlValues, xlPart, xlByRows, xlPrevious)
    If Not rFind Is Nothing Then
        'only look once and save that cell ref
        sFind.Offset(, 1) = rFind.Address
        sFind.Font.Color = -16776961
    Else
        'if not found put default string
        sFind.Offset(, 1) = "No Found"
        sFind.Offset(, 1).Font.Color = -16776961
    End If
Next
Set ms = Nothing
Set ws = Nothing
Set rng = Nothing
Set rFind = Nothing
'enable calculation
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

非VBA - 在Excel 2010上测试：

=IFERROR(VLOOKUP(A2, INDIRECT("Sheet2!" & IF(OR(CODE(UPPER(LEFT(A2, 1)))<65,
    CODE(UPPER(LEFT(A2, 1)))>90), "AA:AA", LEFT(A2, 1)&":"& LEFT(A2, 1))), 1, FALSE), 
    "Not Found")