Excel VBA使用超链接链接两个用户选择的单元格

我目前正在尝试使用超链接自动链接两个用户选择的单元格。 用户可以选择两个不同的单元格（通过输入框依次选择）。对于这两个单元格，应添加指向单元格1到单元格2以及单元格2到单元格1的超链接

到目前为止，我有：

 Option Explicit

Sub Hyperlinks()
Dim FirstHyperlink As Range
Dim SecondHyperlink As Range

Set FirstHyperlink = Application.InputBox("Please select first cell to contain hyperlink", "Hyperlink 1 selection", Type:=8)
Set SecondHyperlink = Application.InputBox("Please select second cell to contain hyperlink", "Hyperlink 2 selection", Type:=8)

ActiveSheet.Hyperlinks.Add Anchor:=FirstHyperlink.Address, Address:="", SubAddress:= _
    SecondHyperlink.Address, TextToDisplay:=FirstHyperlink.Value

ActiveSheet.Hyperlinks.Add Anchor:=SecondHyperlink.Address, Address:="", SubAddress:= _
    FirstHyperlink.Address, TextToDisplay:=SecondHyperlink.Value

End Sub

但是，我得到一个运行时错误13：类型不匹配指向

ActiveSheet.Hyperlinks.Add Anchor:=FirstHyperlink.Address, Address:="", SubAddress:= _
        SecondHyperlink.Address, TextToDisplay:=FirstHyperlink.Value

---

有人知道问题的原因吗

只需修复您的

锚定

：

Option Explicit

Sub Hyperlinks()
Dim FirstHyperlink As Range
Dim SecondHyperlink As Range

Set FirstHyperlink = Application.InputBox("Please select first cell to contain hyperlink", "Hyperlink 1 selection", Type:=8)
Set SecondHyperlink = Application.InputBox("Please select second cell to contain hyperlink", "Hyperlink 2 selection", Type:=8)

ActiveSheet.Hyperlinks.Add Anchor:=FirstHyperlink, Address:="", SubAddress:= _
    SecondHyperlink.Address, TextToDisplay:=FirstHyperlink.Value

ActiveSheet.Hyperlinks.Add Anchor:=SecondHyperlink, Address:="", SubAddress:= _
    FirstHyperlink.Address, TextToDisplay:=SecondHyperlink.Value

End Sub

---

这假设单元格开始时有一些非空值。

只需修复您的

锚定：

Option Explicit

Sub Hyperlinks()
Dim FirstHyperlink As Range
Dim SecondHyperlink As Range

Set FirstHyperlink = Application.InputBox("Please select first cell to contain hyperlink", "Hyperlink 1 selection", Type:=8)
Set SecondHyperlink = Application.InputBox("Please select second cell to contain hyperlink", "Hyperlink 2 selection", Type:=8)

ActiveSheet.Hyperlinks.Add Anchor:=FirstHyperlink, Address:="", SubAddress:= _
    SecondHyperlink.Address, TextToDisplay:=FirstHyperlink.Value

ActiveSheet.Hyperlinks.Add Anchor:=SecondHyperlink, Address:="", SubAddress:= _
    FirstHyperlink.Address, TextToDisplay:=SecondHyperlink.Value

End Sub

这假设单元格以一些非空值开头。
出于完整性原因：

这是我最终使用的代码。我又写了几行代码，使它可以在不同的工作表上工作，而不仅仅是在一个工作表上

Option Explicit

Sub Hyperlinks()
Dim FirstHyperlink As Range
Dim SecondHyperlink As Range
Dim FirstSheet As Worksheet
Dim SecondSheet As Worksheet

Set FirstHyperlink = Application.InputBox("Please select first cell to contain hyperlink", "Hyperlink 1 selection", Type:=8)
Set FirstSheet = FirstHyperlink.Worksheet
Set SecondHyperlink = Application.InputBox("Please select second cell to contain hyperlink", "Hyperlink 2 selection", Type:=8)
Set SecondSheet = SecondHyperlink.Worksheet

ActiveSheet.Hyperlinks.Add Anchor:=FirstHyperlink, Address:="", SubAddress:= _
    "'" & SecondSheet.Name & "'" & "!" & SecondHyperlink.Address, TextToDisplay:=FirstHyperlink.Value

ActiveSheet.Hyperlinks.Add Anchor:=SecondHyperlink, Address:="", SubAddress:= _
    "'" & FirstSheet.Name & "'" & "!" & FirstHyperlink.Address, TextToDisplay:=SecondHyperlink.Value

End Sub

出于完整性原因：

这是我最终使用的代码。我又写了几行代码，使它可以在不同的工作表上工作，而不仅仅是在一个工作表上

Option Explicit

Sub Hyperlinks()
Dim FirstHyperlink As Range
Dim SecondHyperlink As Range
Dim FirstSheet As Worksheet
Dim SecondSheet As Worksheet

Set FirstHyperlink = Application.InputBox("Please select first cell to contain hyperlink", "Hyperlink 1 selection", Type:=8)
Set FirstSheet = FirstHyperlink.Worksheet
Set SecondHyperlink = Application.InputBox("Please select second cell to contain hyperlink", "Hyperlink 2 selection", Type:=8)
Set SecondSheet = SecondHyperlink.Worksheet

ActiveSheet.Hyperlinks.Add Anchor:=FirstHyperlink, Address:="", SubAddress:= _
    "'" & SecondSheet.Name & "'" & "!" & SecondHyperlink.Address, TextToDisplay:=FirstHyperlink.Value

ActiveSheet.Hyperlinks.Add Anchor:=SecondHyperlink, Address:="", SubAddress:= _
    "'" & FirstSheet.Name & "'" & "!" & FirstHyperlink.Address, TextToDisplay:=SecondHyperlink.Value

End Sub