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

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

我一直遇到两个问题：

a、 "对象不受此属性或方法错误的支持（下面说明了行位置）

b、 "将超链接插入到当前图纸上的正确坐标，而不是“main”

我在网上看到的所有示例都使用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

---

代码中有两个问题

使用

范围

对象时，它已经包含工作表上下文，因此，例如，不要使用

工作表（“主”）。W2

只使用

W2

超链接.Add

方法，

SubAddress

参数必须是地址字符串，包括工作表引用。因此，例如，不要使用

子地址：=R2

而使用

子地址：=R2.Address（外部：=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

---

代码中有两个问题

使用

范围

对象时，它已经包含工作表上下文，因此，例如，不要使用

工作表（“主”）。W2

只使用

W2

超链接.Add

方法，

SubAddress

参数必须是地址字符串，包括工作表引用。因此，例如，不要使用

子地址：=R2

而使用

子地址：=R2.Address（外部：=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

---

chris回答中的解决方案适用于代码，另外还有一个：

Option Explicit

Sub hyperlinkinsert()
   Dim wsC As Worksheet, wsM As Worksheet, celC As Range, celM As Range, adr As String

   Set wsM = ThisWorkbook.Worksheets("Main")

   For Each wsC In ThisWorkbook.Worksheets
      If wsC.Index > 3 Then

         Set celM = wsM.UsedRange.Find(What:=wsC.Cells(1, 1).Text)
         Set celC = wsC.UsedRange.Find(What:="Chosen Value")

         If Not celM Is Nothing And Not celC Is Nothing Then

            Set celM = celM.Offset(0, 2)
            Set celC = celC.Offset(0, 1)

            adr = "'" & wsC.Name & "'!" & wsC.Cells(1, 1).Address

            celC.Formula = "=Index(Main!H12:H284,Match(" & adr & ",Main!F12:F284,0))"

            If Not IsError(celC) Then
               wsC.Hyperlinks.Add celC, "", celM.Address(External:=True)
               wsM.Hyperlinks.Add celM, "", celC.Address(External:=True)
            End If
         End If
      End If
   Next
End Sub

---

---

假设：公式中单元格A1的值应从当前表中提取，从chris对代码的回答中提取，再加上一个附加值：

Option Explicit

Sub hyperlinkinsert()
   Dim wsC As Worksheet, wsM As Worksheet, celC As Range, celM As Range, adr As String

   Set wsM = ThisWorkbook.Worksheets("Main")

   For Each wsC In ThisWorkbook.Worksheets
      If wsC.Index > 3 Then

         Set celM = wsM.UsedRange.Find(What:=wsC.Cells(1, 1).Text)
         Set celC = wsC.UsedRange.Find(What:="Chosen Value")

         If Not celM Is Nothing And Not celC Is Nothing Then

            Set celM = celM.Offset(0, 2)
            Set celC = celC.Offset(0, 1)

            adr = "'" & wsC.Name & "'!" & wsC.Cells(1, 1).Address

            celC.Formula = "=Index(Main!H12:H284,Match(" & adr & ",Main!F12:F284,0))"

            If Not IsError(celC) Then
               wsC.Hyperlinks.Add celC, "", celM.Address(External:=True)
               wsM.Hyperlinks.Add celM, "", celC.Address(External:=True)
            End If
         End If
      End If
   Next
End Sub

---

---

假设：公式中单元格A1的值应从当前工作表中提取

非常有效，谢谢！有趣的是，看看你是如何组织代码的，它看起来更干净。我做了一个小的更新，在

adr

中包含了工作表名称-这将正确引用每个工作表中的单元格（这是额外的问题，我想我在测试时删除了它）效果很好，谢谢！有趣的是，看看你是如何组织代码的，它看起来更干净。我做了一个小的更新，在

adr

中包含了工作表名称-这将正确地引用每个工作表中的单元格（这是额外的问题，我想我在测试时某个时候删除了它）