Question

我有一个具有2个工作表的Excel。 Sheet1包含前往Sheet2的HYPERLINK，该表具有分组在一起的数据。单击链接到sheet2后，我想扩展数据组（sheet2）。扩展组后，我想在离开Sheet2时将它们折叠回去。这是我在Sheet1中的HYPERLINK的公式

这是我的数据组Sheet2。

我既不擅长Excel，也不擅长VBA。

非常感谢您的帮助。

Answer 1

由于您使用的是超链接功能，并且不会触发followhyperlink事件，因此这是我的解决方法：

I。添加一个模块来存储全局变量，以跟踪激活sheet2之前的最后选择

步骤

1）添加模块

2）粘贴以下代码：

Option Explicit

' Variable to track last selected cell    
Global selectedCell As Range

这应该是这样的：

II。将变量设置为Sheet1中最后选择的单元格

步骤：

1）双击Sheet1对象

2）添加以下代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    ' Track last selected cell
    Set selectedCell = Target

End Sub

这应该是这样的：

III。在Sheet2中进行测试，以查看最后选择的单元格地址是否来自Sheet1，并且是否在特定范围内，如果是，则展开折叠的详细信息

步骤：

1）双击Sheet2对象

2）添加以下代码：

Private Sub Worksheet_Activate()

On Error GoTo Err_handler

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    ' Check if selectedCell is already set if not, stop processing
    If selectedCell Is Nothing Then
        Sheet1.Activate
        Set selectedCell = Selection
        Sheet2.Activate
    End If

    ' Check if previous cell is "Sheet1!$B$4"
    If selectedCell.Parent.Name & "!" & selectedCell.Address = "Sheet1!$B$4" Then

        ' <<<< Customize the row where the grouped rows begins and are visible
        ' (this row depends whether you have "Summary rows below detail" active or not if it's not active, you have to use the next visible row) >>>>
        With Sheet2.Rows(1)
            .ShowDetail = Not .ShowDetail
        End With

    End If

Exit_Sub:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub

Err_handler:
    MsgBox "Error: " & Err.Number & " " & Err.Description
    Resume Exit_Sub

End Sub

IV。当Sheet2停用时，折叠详细信息

步骤：

1）在Sheet2代码末尾找到光标

2）添加以下代码：

Private Sub Worksheet_Deactivate()

    ' <<<Customize Sheet2 to the Name of your worksheet>>>

    ' Collapse all rows that are grouped
    Sheet2.Outline.ShowLevels RowLevels:=1

End Sub

Sheet2代码应如下所示：

完整的Sheet2代码：

Private Sub Worksheet_Activate()

On Error GoTo Err_handler

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    ' Check if selectedCell is already set if not, stop processing
    If selectedCell Is Nothing Then
        Sheet1.Activate
        Set selectedCell = Selection
        Sheet2.Activate
    End If

    ' Check if previous cell is "Sheet1!$B$4"
    If selectedCell.Parent.Name & "!" & selectedCell.Address = "Sheet1!$B$4" Then

        ' <<<< Customize the row where the grouped rows begins and are visible >>>>
        ' (this row depends whether you have "Summary rows below detail" active or not if it's not active, you have to use the next visible row) >>>>
        With Sheet2.Rows(1)
            .ShowDetail = Not .ShowDetail
        End With

    End If

Exit_Sub:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub

Err_handler:
    MsgBox "Error: " & Err.Number
    Resume Exit_Sub

End Sub

Private Sub Worksheet_Deactivate()

    ' <<<Customize Sheet2 to the Name of your worksheet>>>

    ' Collapse all rows that are grouped
    Sheet2.Outline.ShowLevels RowLevels:=1

End Sub

尝试一下，让我知道。

如何使用HYPERLINK功能在excel中扩展/折叠数据组

1 个答案: