動態超鏈接可基於ActiveCell值（VBA）過濾表

Question

我正在創建一個動態超鏈接，該超鏈接將過濾另一個工作表上的表格（Sheet15）。

我的目標是使用戶能夠在Sheet3上選擇一個單元格，並使該單元格的VALUE作為另一張表上的過濾器。

到目前為止，這是我的代碼：

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    If Target.Type = msoHyperlinkRange And Target.Range.Address = "$S$15" Then
        Application.ScreenUpdating = False
        Sheet15.Visible = True
        Sheet15.ListObjects("Table17").Range.AutoFilter Field:=19, Criteria1:=ActiveCell.Value
        Sheet15.Activate
        Application.ScreenUpdating = True
    End If
End Sub

但是，當我單擊超鏈接時，該表根本沒有被過濾，所以我必須做錯什么。

有人可以協助嗎？

---

更新

這是更新的代碼。

現在，單元格S17是我要將表格過濾到的值：

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    If Target.Type = msoHyperlinkRange And Target.Range.Address = "$S$15" Then
        Application.ScreenUpdating = False
        Sheet15.Visible = True
        Sheet15.ListObjects("Table17").Range.AutoFilter Field:=19, Criteria1:=Sheet3.Range("S17").Value
        Sheet15.Activate
        Application.ScreenUpdating = True
    End If
End Sub

但是問題仍然存在。 當我單擊它們的超鏈接時，將帶到該其他工作表，但該表根本沒有被過濾。

Answer 1

注意：除非超鏈接指向自身，否則ActiveCell.Value將是鏈接目標位置的值 ：如果要從包含鏈接的單元格中獲取值，請使用Target.Range.Value 。

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    If Target.Type = msoHyperlinkRange And Target.Range.Address = "$S$15" Then
        Application.ScreenUpdating = False
        With Sheet15
            .Visible = True
            .ListObjects("Table17").Range.AutoFilter Field:=19, _
                                     Criteria1:=Target.Range.Value
            .Activate
        End With
        Application.ScreenUpdating = True
    End If
End Sub

Answer 2

堅持原始計划，並假設“ A”列是帶有城市名稱的列，請將以下內容放置在工作表代碼窗格中

Option Explicit

Dim lastCell As Range '<--| declare a module scoped range variable to store the last cell selected by the user, if "valid"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$S$15" Then Exit Sub '<-- do nothing if user selected cell with hyperlink
    Set lastCell = Intersect(Target, Columns("A")) '<-- change "Columns("A") to a named range with your cities
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    If lastCell Is Nothing Then Exit Sub '<--| no action if lastCell has not been properly set by 'Worksheet_SelectionChange()'

    If Target.Type = msoHyperlinkRange And Target.Range.Address = "$S$15" Then
        Application.ScreenUpdating = False
        Sheet15.Visible = True
        Sheet15.ListObjects("Table17").Range.AutoFilter Field:=19, Criteria1:=lastCell.Value '<--| set the criteria as 'lastCell' value
        Sheet15.Activate
        Application.ScreenUpdating = True
    End If
End Sub

根據評論，您將Worksheet_SelectionChange() Columns("A")引用更改為帶有城市名稱的實際范圍（也許是命名范圍 ）