Excelmacros在一列中search多个url

我有一个工作表（Sheet2），其中包含27列，第一行是AZ列和NUM共27列。 每列都有一个很长的受限制的url列表，按照列的字母sorting，最后（第27）列是以数字开头的url。 专栏的长度在300-600千个细胞之间。

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

工作表Sheet1

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将在网上运行另一个在线testing后被添加到Sheet2中。

令人惊讶的是，我find了下面的脚本（错过了它的源代码）

 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）。 这个脚本是一个“乌龟”，用了一个小时的时间来检查一个167个网站的列表！

这个脚本可以修改成“兔子”吗？ 🙂

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

像往常一样，先谢谢了。

Answer 1

试试这个 – 在Excel 2010中testing：

 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 aa 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上testing：

 =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")