點擊超鏈接不同工作表單元格變化值鏈接單元格的值

Question

我有充分的價格優惠和一個單獨的工作表，這使得改建爲基於以下因素，如條件這個價格表。

由於有相當多的全價優惠，我認爲一個簡單的方法是將每個價格設置爲一個超鏈接，將其複製到工作表中的單元格中進行價格調整，價格將自動調整。

我對VBA不太好，但是我已經想出了一個基本的代碼。

Dim ClickCell As String 

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) 
    If Sh.Name = "Book 1" Then 
     If ClickCell = "A3" Then 
      Sheets("Book 2").Range("B2").Value = "Sample Data" 
     End If 
    End If 
End Sub 

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 
    If Sh.Name = "Book 1" Then 
     ClickCell = Target.Address(False, False) 
    End If 

End Sub 

與此代碼（我將能夠IF語句更改爲範圍，以覆蓋包含價格整列）的主要問題是，我不能獲得一個包含該單元格的值超鏈接並粘貼到單元格B2。 ActiveCell.Value似乎只是複製了B2的價值（價格應該被粘貼的單元格，本質上取代了該單元格的價值），並且BeforeDoubleClick似乎並不適合我。

最後，因爲它運行在不同的工作表上，所以我一直運行這個代碼作爲工作簿模塊，是嗎？

編輯：被要求提供數據樣本（我不確定這是否正確）。

Sheet1

Sheet2

Answer 1

目標包含在其中超鏈接所在的小區。您可以從Target.SubAddress獲取位置（請參閱代碼註釋）：

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) 
    Dim subAddress() As String 

    If Sh.Name = "Book 1" Then 
     ''.SubAddress is for example 'Book 2'!B2 
     ''Get sheet name by splitting into an array by delimiter ! 
     subAddress = Split(Target.subAddress, "!") 
     ''Trim ' from the first item 
     subAddress(0) = Replace(subAddress(0), "'", "") 

     Sheets(subAddress(0)).Range(Target.subAddress).Value = Target.Range.Value 
    End If 
End Sub