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

Posted 2021-05-03

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

Example

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

我怎样才能克服限制？或者如何使用宏或VBS合并具有相等值的单元格？

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

答案

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

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

另一答案

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

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

另一答案

如果你将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，则可能会管理它

另一答案

我遇到了同样的问题，我知道我不应该有大约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

希望通过谷歌（像我一样）帮助其他人偶然找到一个可行的解决方案......