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

时间:2016-03-08 17:28:05

标签: vba excel-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

1 个答案:

答案 0 :(得分:0)

我看到要搜索的单元格内容已更新

所以这里是经过修改的代码

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

此时我认为您宁愿将该代码限制在您的主代码调用的函数中,如下所示

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