使用vba向名称添加超链接

我的VBA技能是不存在的，我一直无法找到任何线程适合我的情况，因此这个线程

我在Excel工作表中有一列包含名称（B列），我正在尝试将B中的单元格超链接到网页。每行有一个特定的网页

如果我有一个包含所有相应URL的列，那么只使用超级链接功能就很容易了，但问题是电子表格的最终版本不会有包含URL的列

最终版本将包括： （B列）超链接到特定网页的名称，以及 （A列）ID，包括URL的唯一部分和来自B的名称

除了末尾的数字外，URL都是相同的。 不变的部分是：

http://www.regulations.gov/#!documentDetail;D=CFPB-2011-0008

每个URL的末尾都有一个四位数的数字

以“CFPB”开头、以四位数字结尾的位是将包含在A列中的部分

因此，我的计划是编写一个VBA程序，使用从中构造的URL向B添加超链接

http://www.regulations.gov/#!documentDetail;D=

以及A中相应单元的前部（例如CFPB-2011-0008-0002）。我正在考虑使用LEFT函数从一个（例如LEFT（A1,19））中获取URL的第二部分

---

对不起，如果解释不清楚。。。任何帮助都将不胜感激。

前几天我编写了一个脚本来执行类似的操作，您可能希望将其放入循环或其他内容中，以浏览电子表格中的列表。我使用iCurrentRow和iCurrentCol在工作表中导航

使用您建议的函数在您想要的单元格（即B列的单元格）中生成超链接字符串，然后将strString设置为此值。我刚刚添加了strString（尚未测试），所以如果它不起作用，那么您可能需要将它包含在CStr（）中

无论如何，它应该给你一些工作上的东西

' Set the string to the hyperlink address    
strString = Cells(iCurrentRow, iCurrentCol).value
' Check if the cell already has a hyperlink
If Cells(iCurrentRow, iCurrentCol).Hyperlinks.Count > 0 Then
    'If it does then check if it is the same as in the cell
     If strString  <> CStr(Cells(iCurrentRow, iCurrentCol).Hyperlinks(1).Address) Then
         'Check if there is no new hyperlink
          If strString = "" Then
              Cells(iCurrentRow, iCurrentCol).Hyperlinks.Delete
          Else
              ActiveSheet.Hyperlinks.Add Anchor:=Cells(iCurrentRow, iCurrentCol), _
                  Address:=strString
          End If
      End If
Else
    'If there isn't an existing hyperlink then add it
     If strString <> "" Then
         ActiveSheet.Hyperlinks.Add Anchor:=Cells(iCurrentRow, iCurrentCol), _
             Address:=strString 
     End If
End If

”将字符串设置为超链接地址
strString=单元格（iCurrentRow，iCurrentCol）.value
'检查单元格是否已具有超链接
如果单元格（iCurrentRow，iCurrentCol）.Hyperlinks.Count>0，则
'如果是，则检查它是否与单元格中的相同
如果strString CStr（单元格（iCurrentRow，iCurrentCol）.Hyperlinks（1）.Address），则
'检查是否没有新的超链接
如果strString=“”，则
单元格（iCurrentRow，iCurrentCol）.Hyperlinks.Delete
其他的
ActiveSheet.Hyperlinks.Add锚定：=单元格（iCurrentRow，iCurrentCol）_
地址：=strString
如果结束
如果结束
其他的
'如果没有现有的超链接，请添加它
如果字符串“”则
ActiveSheet.Hyperlinks.Add锚定：=单元格（iCurrentRow，iCurrentCol）_
地址：=strString
如果结束
如果结束

尝试一下：

Sub MAIN()
    Dim rng As Range, rr As Range, r As Range
    Set rng = Intersect(Range("B:B"), ActiveSheet.UsedRange)

    For Each rr In rng
        If rr.Value <> "" Then
            Set r = rr
            Call hyper_maker(r)
        End If
    Next rr
End Sub

Sub hyper_maker(r As Range)
    If r.Hyperlinks.Count > 0 Then
        r.Hyperlinks.Delete
    End If
    txt = r.Value
    s = "http://www.regulations.gov/#!documentDetail;D=" & txt
    r.Value = s
    r.Select
    Application.SendKeys "{F2}"
    Application.SendKeys "{ENTER}"
    DoEvents
    r.Hyperlinks(1).TextToDisplay = txt
End Sub

Sub-MAIN（）
变光rng As范围、后视镜As范围、后视镜As范围
设置rng=Intersect（范围（“B:B”），ActiveSheet.UsedRange）
对于rng中的每个rr
如果rr.Value为“”，则
设置r=rr
呼叫超链接生成器（r）
如果结束
下一个rr
端接头
子超链接生成器（r As范围）
如果r.Hyperlinks.Count>0，则
r、 超链接。删除
如果结束
txt=r.值
s=”http://www.regulations.gov/#！documentDetail；D=“&txt
r、 值=s
r、 挑选
Application.SendKeys“{F2}”
Application.SendKeys“{ENTER}”
多芬特
r、 超链接（1）。TextToDisplay=txt
端接头

我正确理解了这个问题，您可以通过一个简单的工作表函数来完成。只需将URL连接在一起：

=HYPERLINK(CONCATENATE("http://www.regulations.gov/#!documentDetail;D=",LEFT(A1,14)))

一种仅向现有文档名称添加URL的VBA解决方案如下：

Sub AddHyperlinks()

    Dim url As String

    Dim current As Range
    For Each current In Selection.Cells
        url = "http://www.regulations.gov/#!documentDetail;D=" & _
              Left$(current.Value, 14)
        current.Worksheet.Hyperlinks.Add current, url
    Next current

End Sub

---

选择要向其中添加超链接的单元格并运行宏。

将不起作用。因为URL中有

#

@AxelRichter-在URL上工作得很好（至少当我在Excel2010中尝试它时）。唯一奇怪的是，工具提示用连字符替换了#，但单击时仍然加载了正确的页面。链接的知识库仅指在文件名中使用

#

。@Comintern。您的答案不适用于Excel 2007。超链接调用

http://www.regulations.gov/%20-%20!文件细节；D=CFPB-2011-0008

失败。@AxelRichter-有趣。我想知道他们是否在Excel 2010中解决了这个问题。@Comintern:将Excel 2007和IE 11组合作为默认浏览器似乎有问题。使用Chrome作为默认浏览器，它可以正常工作。我刚刚运行了这个程序，它工作得非常好，只是它看起来像是以A列中名称的前14个字符而不是B列中的ID结尾的url。我想在引用ID时超链接这些名称。假设ID为的列位于名称为的列的左侧，是否有方法将left函数中的current.Value替换为表示“活动单元格左侧的单元格”的内容？非常感谢。@hwin-您可以将

当前.Value

替换为

当前.Offset（0，-1）.Value