vba - 循环添加引用正确单元格坐标但在错误工作表上的超链接

Question

此代码旨在在当前工作表上找到与“主”工作表上的单元格相对应的单元格，然后插入在两个单元格之间双向工作的超链接。两个超链接上显示的实际文本应该是在“主”表的单元格中找到的数值。

我一直遇到两个问题:

一个。 “此属性或方法不支持对象”错误(如下所示的行位置)

湾。 '插入到正确坐标的超链接，但在当前工作表上，而不是'主'

我在网上查看的所有示例都使用 sheet.hyperlink.add 所以我很困惑为什么我使用相同的语法收到此错误

到目前为止，这是我的代码

Sub hyperlinkinsert()

Dim Sh As Worksheet

Dim r As Range
Dim R2 As Range

Dim w As Range
Dim W2 As Range

Dim S1 As String
Dim i As Integer

i = 0

    For Each Sh In ThisWorkbook.Worksheets

    i = i + 1

        If i > 3 Then

                S1 = Sh.Cells(1, 1).Text

                Set r = Sh.Cells.Find(What:="Chosen Value")

                    If Not r Is Nothing Then

                        Set R2 = r.Offset(0, 1)

                        Set w = Sheets("Main").Cells.Find(S1)

                            If Not w Is Nothing Then

                                  Set W2 = w.Offset(0, 2)


                                      R2.Formula = "=Index('Main'!H12:H284,Match(A1,'Main'!F12:F284,0))"

                           '**** ERROR MSG OCCURS HERE  ****
                                      Sh.Hyperlinks.Add Anchor:=R2, Address:="", _
                                      SubAddress:=Sheets("Main").W2, TextToDisplay:=R2.Value

                                      Sheets("Main").Hyperlinks.Add Anchor:=Sheets("Main").W2, _
                                      Address:="", SubAddress:=R2, TextToDisplay:=Sheets("Main").W2.Value

                            End If

                    End If


                Set r = Nothing
                Set R2 = Nothing
                Set w = Nothing
                Set W2 = Nothing

        End If


    Next


End Sub

Answer 1

您的代码中有两个问题

使用 Range 时对象，它已经包含工作表上下文，例如，而不是 Sheets("Main").W2仅使用 W2

Hyperlinks.Add方法，SubAddress参数需要是地址字符串，包括工作表引用。例如，而不是 SubAddress:=R2使用 SubAddress:=R2.Address(External:=True)

把这些放在一起，你的超链接代码应该是

Sh.Hyperlinks.Add Anchor:=R2, Address:="", _
  SubAddress:=W2.Address(External:=True), TextToDisplay:=R2.Value

Sheets("Main").Hyperlinks.Add Anchor:=W2, Address:="", _
  SubAddress:=R2.Address(External:=True), TextToDisplay:=W2.Value