1

我有一个包含 27 列的工作表（Sheet2），第一行是列标题，它们是 AZ 和 NUM，共 27 列。每列都有一个非常长的受限 url 列表，按列的字母排序，最后（第 27 列）用于以数字开头的 url。列的长度在 300-60 万个单元格之间。

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

表 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

因此，在为该 url 运行另一个在线测试后，“待添加”的 url 将被添加到 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

使用一小部分 url（例如 5-10）运行这个脚本非常棒。Sheet1 col-A 中的列表较长，Sheet2 中的列表像我的一样长，这个脚本是“乌龟”，检查 167 个 url 的列表需要一个多小时！

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

高度赞赏在这方面提供的任何帮助。

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

4

1 回答 1

0

试试这个 - 在 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")
于 2013-04-15T08:36:56.990 回答