从vba excel中的字符串中提取URL

我想从存储在单元格中的字符串中提取URL。从vba excel中的字符串中提取URL

在下面的示例中，该字符串位于A2中，我只想提取"abcd.co.uk"。你能帮忙吗？

abcd company 
. local technicians 
. solutions 
. Experts ¡n all areas 
abcd ***abcd.co.uk***

我尝试了多种方式，但无法使其工作。

Sub url() 
    abc = Range("A2") 

    t_temp = Split(abc, ".co.uk") 
    Range("A3") = t_temp 
    t_temp_text2 = Mid(t_temp, 1, InStr(t_temp, " ")) 
End Sub

来源

2016-03-08 Srinivas Mantri

你的最好的方法在这里是使用正则表达式。很难建议什么样的模式是合适的，没有更多的例子URL's –

我看要搜索的已更新

细胞含量，所以这里来了所以修改后的代码

Option Explicit 

Sub GetUrl2() 
Dim abc As Range 
Dim urlString As String 
Dim iPosIni As Integer, iPosEnd As Integer 

Set abc = ActiveSheet.Range("A2") '<== change it to your needs 

iPosEnd = InStrRev(abc.Value, "***") 
iPosIni = InStrRev(Mid(abc.Value, 1, iPosEnd), "***") + 3 

urlString = Mid(abc.Value, iPosIni, iPosEnd - iPosIni) 

End Sub

可以缩短，在可读性为代价的，如如下所示

Sub GetUrl3() 
Dim abc As Range 
Dim urlString As String 
Set abc = ActiveSheet.Range("A2") '<== change it to your needs 

urlString = Mid(abc.Value, _ 
       InStrRev(Mid(abc.Value, 1, InStrRev(abc.Value, "***")), "***") + 3, _ 
       InStrRev(abc.Value, "***") - _ 
       (InStrRev(Mid(abc.Value, 1, InStrRev(abc.Value, "***")), "***") + 3) _ 
       ) 

End Sub

在这一点上，我认为你宁愿将该代码限制在一个有趣的ction由主代码如下一样

Sub Main() 
Dim urlString As String 

urlString = GetUrl(ActiveSheet.Range("A2").Value) 

End Sub 


Function GetUrl(strng As String) As String 

GetUrl = Mid(strng, _ 
       InStrRev(Mid(strng, 1, InStrRev(strng, "***")), "***") + 3, _ 
       InStrRev(strng, "***") - _ 
       (InStrRev(Mid(strng, 1, InStrRev(strng, "***")), "***") + 3) _ 
       ) 

End Function

来源

2016-03-08 17:42:50 user3598756

谢谢你考虑这个..但urlString返回空白。你可以建议 –

我测试过“abcd company。local technicians。solutions。专家”所有区域abcd dabcd.co.uk2“放在活动工作表的A2单元中并且工作正常。请确保ActiveSheet实际上是单元格A2包含所需内容并且该URL是单元格中最后一个信息的工作表。在即时窗口中逐步执行代码和查询尝试（InStrRev（abc.Value，“”）） – user3598756

这里有一个基本的正则表达式例如被称为：

Sub GetDomains() 

    Dim reg As Object, tester As String, ms, m 

    Set reg = CreateObject("VBscript.Regexp") 

    tester = Range("A1").Value 

    reg.IgnoreCase = True 
    reg.MultiLine = False 
    reg.Pattern = "([a-z0-9.-]{1,}\.[a-z0-9.-]{2,}(\.[a-z0-9.-]{2,})?)" 

    Set ms = reg.Execute(tester) 
    If Not ms Is Nothing Then 
    For Each m In ms 
     Debug.Print m.Value 
    Next m 
    End If 

End Sub

来源

2016-03-08 19:28:47

从vba excel中的字符串中提取URL

回答

相关问题