使用vba添加超链接到名称
我的VBA技能是不存在的，我一直无法find适合我的情况的线程，因此这个线程。
我有一个包含名称（B列）的Excel工作表中的列，我试图将B中的单元格超链接到网页。 每行有一个特定的网页。
如果我有一个包含所有对应的URL的列，那么使用HYPERLINK函数会很容易，但问题是电子表格的最终版本不会有一个包含URL的列。
最终版本将包括：（B列）超链接到特定网页的名称，以及（列A）ID，其中包括URL的唯一部分加上B的名称
除了最后的数字外，这些url都是相同的。 不变的部分是：
http://www.regulations.gov/#!documentDetail;D=CFPB-2011-0008 每个url最后有一个四位数的数字。
以“CFPB”开始并以四位数字结尾的位是将被包括在A列中的部分。
所以我的计划是编写一个VBA程序，使用从中构build的URL来向B添加超链接
http://www.regulations.gov/#!documentDetail;D=
和A中相应单元的前部（例如CFPB-2011-0008-0002）。 我正在考虑使用LEFT函数从A（例如LEFT（A1,19））获取URL的第二部分。
对不起，如果解释不清楚…任何帮助将不胜感激。
我正确地理解了这个问题，你可以用一个简单的工作表函数来做到这一点。 只需将URL连接在一起：
=HYPERLINK(CONCATENATE("http://www.regulations.gov/#!documentDetail;D=",LEFT(A1,14)))
一个VBA解决scheme只是将URL添加到现有的文档名称将是这样的：
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
select要添加超链接的单元格并运行macros。
前几天我把一个脚本放在一起做类似的事情，你会想把它放到一个循环中或者在电子表格中通过你的列表。 我使用iCurrentRow和iCurrentCol来导航我的工作表。
使用你build议在你想要的单元格中build立超链接string的函数，即列B中的单元格，然后将strString设置为这个值。 我刚刚添加了strString（尚未testing），所以如果不起作用，那么您可能需要将其包含在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
试试这个：
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