单击 Excel 中的超链接以在其他工作表上设置自动筛选



我有一个包含两张工作表的 Excel 工作簿,基本上是两张工作表之间的一对多设置。 第一张表列出了数百家公司,第二张表列出了公司的董事会。 第二个工作表具有自动筛选器,因此用户可以查看从筛选器中选择的特定公司的董事会成员。

我正在尝试做的是让用户单击第一张纸上的公司单元格,这样用户就会被带到下一张纸上,自动过滤器已经填充了所选的公司。 这样,用户只能直接访问所选公司的董事会成员。

我想这将需要 VBA,并希望有人能为我指出创建此代码以解决此问题的正确方向。 非常感谢。

您可以通过

在工作表模块中执行以下操作来实现此目的:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Update Table14 to your table name
    'Update Field to column number of the field you are filtering
    'Update Sheet7 to reference the sheet containing your table
    'Change on to the column number where your click should cause this action
    If ActiveCell.Column = 1 Then
    Sheet7.ListObjects("Table14").Range.AutoFilter Field:=1, Criteria1:=ActiveCell.Value
    'Update Sheet7 to reference the sheet containing your table
    Sheet7.Activate
    End If
End Sub

您需要打开可视化基本编辑器,右键单击公司工作表,查看代码,将其粘贴到:

Option Explicit
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim CompanyName As String
        If Selection.Count = 1 Then
            If Not Intersect(Target, Range("C1").EntireColumn) Is Nothing Then
                'This code is triggered when any
                'ONE cell in column C is selected
                'Simply change "C1" to "B1" etc etc

                'This MsgBox returns the selected cell
                MsgBox Target.Address
                'You'll probably need to collect some information
                'in this section. You can then use this to affect
                'the filters on sheet 2.
                'Perhaps like this
                CompanyName = Cells(Target.Row, 1).Value
                MsgBox CompanyName
                'This changes to "Sheet2"
                Sheets("Sheet2").Activate
            End If
        End If
    End Sub

希望有帮助,你可以做点什么

最新更新