Excel宏在一列中搜索多个网址 [英] Excel macro to search multiple urls in one column
问题描述
我一直在寻找的是一个宏脚本，它将检查列A中的所有新添加的URL，找出它们是否存在于Sheet2中，导致用已经存在或要添加的每个url标记，如：
Sheet1
Col（A）Col（B）
badsite1.com已经存在
badsite2.com已经存在
badsite3。 com添加
badsite4.con要添加
badsite5.com已经存在
因此添加将在网上运行另一个测试之后添加到Sheet2中。
令人惊讶的是，我发现了以下脚本（错过了它的源代码）这正是我应用了一些细微修改之后：
Sub x（）
Dim rFind As Range，sFind As Range，sAddr As String，ws As Worksheet，rng As Range，ms As Worksheet
Applica
设置ms =表（Sheet1）
ms.Range（B2：B& Rows.Count）.ClearContents
设置rng = ms.Range（A2：A& Cells（Rows.Count，1）.End（xlUp）.Row）
对于每个sFind In rng
用ws.UsedRange
设置rFind = .Find（sFind，.Cells（.Cells.Count），xlValues，xlPart）
如果不是rFind是没有，然后
sAddr = rFind.Address
Do
sFind.Offset（，1）= rFind.Address
sFind.Font.Color = -16776961
设置rFind = .FindNext（rFind）
循环while rFind.Address<> sAddr
sAddr =
Else
sFind.Offset（，1）=找不到
sFind.Offset（，1）.Font.Color = -16776961
结束如果
结束
下一个
设置ms =没有
设置ws =没有
设置rng =没有
设置rFind =没有
Application.ScreenUpdating = True
End Sub
运行此脚本非常棒，带有一个小列表的网址（例如5-10）。在Sheet1 col-A和Sheet2中的HUGE列表中有一个较长的列表，像我的这个脚本是一个乌龟，花了一个小时来检查167个URL的列表！
这个脚本可以修改为兔子吗？ :)
高度赞赏在这方面提供的任何帮助。
像往常一样...提前感谢。 / p>
尝试这个 - 在Excel 2010中测试：
Sub x（）
Dim rFind As Range，sFind As Range，sAddr As String，ws As Worksheet
Dim rng As Range，ms As Worksheet as as String
Application.ScreenUpdating = False
'停止计算
Application.Calculation = xlCalculationManual
设置ws =表（Sheet2）
设置ms =表（Sheet1 ）
ms.Range（B2：B& ms.Rows.Count）.ClearContents
ms.Range（A2：B& ms.Rows.Count）.Font.Color = 0
设置rng = ms.Range（A2：A& ms.Cells（ms.Rows.Count，1）.End（xlUp）.Row）
对于每个sFind在rng
'获取url的第一个字符
s =左（sFind，1）
'诉诸列aa如果不是aa到z
如果Asc（UCase（s））< ; 65或Asc（UCase）> 90然后s =AA
'只查看适当的列
设置rFind = ws.Columns（s）.Find（sFind，xlValues，xlPart，xlByRows，xlPrevious）
如果不是rFind Is Nothing然后
'只看一次并保存该单元格ref
sFind.Offset（，1）= rFind.Address
sFind.Font.Color = -16776961
Else
'如果没有找到put default string
sFind.Offset（，1）=No Found
sFind.Offset（，1）.Font.Color = -16776961
End If
下一个
设置ms =没有
设置ws =没有
设置rng =没有
设置rFind =没有
'启用计算
应用程序。计算= xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
非VBA - 经过测试Excel 2010：
= IFERROR（VLOOKUP（A2，INDIRECT（Sheet2！ F（OR（CODE（UPPER（LEFT（A2，1）））< 65，
CODE（UPPER（LEFT（A2，1）））> 90），AA：AA，LEFT ，1）&：& LEFT（A2，1））），1，FALSE），
找不到）
I have a worksheet (Sheet2) that contains 27 columns, first row is the columns headers which are A-Z and NUM totaling 27 cols. Each column has a very long list of restricted urls sorted to the letter of the column, and the last (27th) column is for urls that start with a number. The columns' length is between 300-600 thousand cells.
What I have been looking for was a macro script that will examine all newly added urls in col A Sheet1, to find out whether they exist in Sheet2, resulting in flagging each url with "already exist" or "to be added", something like:
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
Accordingly "to be added" urls will be added to Sheet2 after running another test online for that url.
Amazingly, I found the following script (missed its source) that does exactly what I'm after applying some minor modifications:
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
Running this script is fantastic with a small list of urls (e.g 5-10). With a longer list in Sheet1 col-A and HUGE lists in Sheet2 like mine, this script is a "tortoise", and it took over one hour to examine a list of 167 urls!!
Can this script be modified to be a "rabbit"? :)
Highly appreciating any offered assistance in this regard.
As usual.. thanks in advance.
Try this - Tested in 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
Non VBA - Tested on 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")
这篇关于Excel宏在一列中搜索多个网址的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
