如何克服Excel中超链接的限制？答案

【问题标题】：How to overcome the limit of hyperlinks in Excel?如何克服Excel中超链接的限制？
【发布时间】：2017-05-30 21:30:27
【问题描述】：

我有一个包含超过 100000 个单元格的链接列表。

我必须为所有这些提供超链接，但在 Excel 中，每个工作表有 66530 个超链接的限制。

如何克服限制或如何使用 VBA 合并具有相等值的单元格？

Sub AddHyperlinks()

    Dim myRange As Range
    Set myRange = Range("A1")
    Dim hText As Variant

    Do Until IsEmpty(myRange)

        hText = Application.VLookup(myRange.Value, Worksheets("Sheet2").Range("A:B"), 2, False)

        If IsError(hText) Then
            hText = ""
        Else
            ActiveSheet.Hyperlinks.Add Anchor:=myRange, Address:="http://" + hText, TextToDisplay:=myRange.Text
            hText = ""
        End If

        Set myRange = myRange.Offset(1, 0)
    Loop

End Sub

【问题讨论】：

如果您不需要一次打开多个文件，请使用具有动态位置的按钮（通过工作表选择更改）打开文件（将实际路径存储在另一列中）。
您可以将一个超链接用于一系列连续单元格
@Slai 你能帮我用宏来做这件事吗？
您能否发布您当前从上一个问题中获得的代码，以便我可以正确获取范围和工作表名称。另外，键值对是否与重复值的顺序相同？
@Slai 将代码添加到问题中...它为一个单元格添加了一个链接。在 Sheet2 上，我有 key->value 部分，例如：AAAAA.jpg BBBBB.jpg CCCCC.jpg in column A 和 www.111.com www.222.com www.333.com in column B `

标签： excel vba hyperlink

【解决方案1】：

@Rory 提到的解决方案是：使用单元格中的 HYPERLINK 函数通过公式模拟超链接。

=HYPERLINK(url, displaytext)

这有效地绕过了“硬编码”超链接的内置 Excel 限制。在我遇到臭名昭著的错误 1004 后刚刚对此进行了测试：

Application-defined or object-defined error

尝试在工作表中创建 100k+ 超链接时。

【讨论】：

【解决方案2】：

只是常规的复制粘贴应该可以工作，但如果没有，我可以更新示例（未测试）

Sub AddHyperlinks() 

    Dim rng As Range, rngFrom As Range, values, r
    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1")
    Set rngFrom = ThisWorkbook.Worksheets("Sheet2").Range("A:A")

    rng.Worksheet.Hyperlinks.Delete   ' remove all previous Hyperlinks

    While rng(1) > ""

        ' resize the range to the same values
        While rng(rng.Rows.Count + 1) = rng(1)
            Set rng = rng.Resize(rng.Rows.Count + 1)
        Wend

        r = Application.Match(rng(1), rngFrom, 0)    
        If Not IsError(r) Then
            values = rng.Value2    ' save the values 
            rngFrom(r, 2).Copy rng ' copy from the cell next to the match
            rng.Value2 = values    ' restore the values (not sure if it removes the links) 
        End If

        Set rng = rng(rng.Rows.Count + 1) ' move to the next cell below
    Wend

End Sub

【讨论】：

非常感谢...一切似乎都按预期进行。请问会出现什么问题吗
我有点惊讶它没有任何问题，因为我主要是在猜测，我无法测试它。如果是与我的回答或这个问题有关的问题，当然可以。
我遇到了一些问题，如果我在列中有空闲单元格，则脚本正在中断。我该如何解决？
@ZeroEight 我猜你可以用类似While rng.Row <= rng.Worksheet.UsedRange.Rows.Count的东西替换While rng(1) > ""

【解决方案3】：

255 个字符的限制适用于一个单元格的公式中可以放入的字符限制。一种常见的方法是将链接拆分为多个单元格并使用公式将它们组合起来。

=HYPERLINK(A1&A2,"Click Here")

【讨论】：

没有字符限制。每个工作表的超链接数量有限制support.office.com/en-us/article/…
AFAIK，但在使用 HYPERLINK 公式时，65536 的限制并不适用。

【解决方案4】：

如果您将 URL 存储在（例如）colA 中，那么这样的东西应该可以工作：

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim URL
    If Target.Column <> 1 Then Exit Sub '<< only reacting if cell in URL column is right-clicked
    URL = Target.Value
    ThisWorkbook.FollowHyperlink URL
End Sub

或者使用Before_DoubleClick 事件

这确实意味着您不能使用“友好”的链接文本，例如“单击此处”，但如果您将 URL 文本存储在固定偏移处然后读取它而不是 Target.Value，您可能会管理它/p>

【讨论】：

【解决方案5】：

我遇到了同样的问题，我知道我不应该有超过 120000 行需要超链接，所以修改了我在另一个线程中找到的一些代码

Sub hyperlink2()
Dim Cell As Range
Dim Cell2 As Range
Dim rng As Range
Dim Rng2 As Range

Set rng = Range("X2:X60000")


For Each Cell In rng
    If Cell <> "" Then ActiveSheet.Hyperlinks.Add Cell, Cell.Value
Next

Set Rng2 = Range("X60001:X120000")
For Each Cell2 In Rng2
    If Cell2 <> "" Then ActiveSheet.Hyperlinks.Add Cell2, Cell2.Value
Next

End Sub

希望能帮助其他通过谷歌偶然发现此问题的人（就像我一样）寻找可行的解决方案...

【讨论】：