提示:其它语言是由 Google 机器翻译的。 你可以访问 English 版本。
登录
x
or
x
x
马上登记
x

or

如何双击单元格以在Excel中打开指定的工作表?

您是否想要快速导航到Excel工作簿中的指定工作表? 本文将提供一个VBA方法,通过双击Excel中的某个单元格来打开指定的工作表。

双击一个单元格以打开一个带有VBA代码的指定工作表

Office选项卡在Office中启用选项卡式编辑和浏览,使您的工作更轻松......
Kutools for Excel - 最佳办公生产力工具将解决您的大部分Excel问题
  • 重用任何东西: 将最常用或最复杂的公式,图表和其他任何内容添加到您的收藏夹中,并在将来快速重复使用它们。
  • 超过20文本功能: 从文本字符串中提取数字; 提取或删除部分文本; 将数字和货币转换为英语单词...
  • 合并工具:多个工作簿和表格合二为一; 合并多个单元格/行/列而不丢失数据; 合并重复行和总和...
  • 拆分工具:根据价值将数据拆分为多个表格; 一个工作簿到多个Excel,PDF或CSV文件; 一列到多列......
  • 粘贴跳过 隐藏/过滤行; 数和总和 按背景颜色; 创建邮件列表和 通过Cell的价值发送电子邮件...
  • 超级过滤器: 创建高级过滤方案并应用于任何工作表; 排序 按周,日,频率等; 筛选 通过大胆,公式,评论......
  • 超过300强大的功能; 适用于Office 2007-2019和365; 支持所有语言; 在公司轻松部署; 全功能60天免费试用。

双击一个单元格以打开一个带有VBA代码的指定工作表


请按照以下步骤通过双击Excel中的单元格打开指定的工作表。

1。 右键单击包含要打开工作表的单元格的工作表选项卡,方法是单击它。 然后点击 查看代码 从上下文菜单。 看截图:

2。 在开幕式上 Microsoft Visual Basic for Applications 窗口,请将以下VBA代码复制到代码窗口中。

VBA代码:双击单元格以在Excel中打开指定的工作表

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Updated by Extendoffice 20180822
Dim xArray, xAValue As Variant
Dim xFNum As Long
Dim xStr, xStrRg, xStrSheetName As String
xRgArray = Array("A1;Sheet2", "A12;Sheet3", "A4;Sheet4", "A100;Sheet5")
On Error Resume Next
For xFNum = LBound(xRgArray) To UBound(xRgArray)
xStr = ""
xStr = xRgArray(xFNum)
xAValue = ""
xAValue = Split(xStr, ";")
xStrRg = ""
xStrRg = xAValue(0)
xStrSheetName = ""
xStrSheetName = xAValue(1)
If Not Intersect(Target, Range(xStrRg)) Is Nothing Then
Sheets(xStrSheetName).Activate
End If
Next
End Sub

注意:在VBA代码中,“A1; Sheet2“”A12; Sheet3“”A4; Sheet4“”A100; Sheet5“意味着单击单元格A1将打开Sheet2,双击A2将打开Sheet3 ...,请根据您的需要更改它们。

3。 按 其他 + Q 钥匙一起关闭 Microsoft Visual Basic for Applications 窗口。

从现在开始,当前工作表中双击单元格A1时,将立即激活指定的工作表。


相关文章:


Kutools for Excel - 最佳办公生产力工具提高80%的生产力

  • 重用: 快速插入 复杂的公式,图表 以及你以前用过的任何东西; 加密单元格 密码; 创建邮件列表 并发送电子邮件...
  • 超级方程式酒吧 (轻松编辑多行文字和公式); 阅读布局 (轻松读取和编辑大量单元格); 粘贴到过滤范围...
  • 合并单元格/行/列 不丢失数据; 分裂细胞含量; 组合重复的行/列...防止重复的细胞; 比较范围...
  • 选择复制或唯一 行; 选择空行 (所有细胞都是空的); 超级查找和模糊查找 在许多工作簿中; 随机选择......
  • 精确复制 多个单元格而不更改公式参考; 自动创建参考 多张表; 插入项目符号,复选框等等......
  • 提取文本,添加文本,按位置删除, 删除空间; 创建和打印分页小计; 在单元格内容和注释之间转换...
  • 超级过滤器 (将过滤方案保存并应用到其他工作表); 高级排序 按月/周/日,频率等; 特殊过滤器 用粗体,斜体......
  • 结合工作簿和工作表; 根据键列合并表; 将数据拆分为多个表格; 批量转换xls,xlsx和PDF...
  • 超过300强大的功能。 支持Office / Excel 2007-2019和365。 支持所有语言。 在您的企业或组织中轻松部署。 全功能60天免费试用。
kte tab 201905

Office选项卡为Office提供选项卡式界面,使您的工作更轻松

  • 在Word,Excel,PowerPoint中启用选项卡式编辑和阅读,Publisher,Access,Visio和Project。
  • 在同一窗口的新选项卡中打开并创建多个文档,而不是在新窗口中。
  • 通过50%提高您的工作效率,每天为您减少数百次鼠标点击!
官方底部
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Carl · 2 months ago
    Hi Crystal

    I have copied the code and edited according to the name of the worksheets. The code is running but I still cannot open the sheets, what have I done wrong?

    Sub OpenbyDoubleclicking(ByVal Target As Range, Cancel As Boolean)

    Dim xArray, xAvlaue As Variant '
    Dim xFSum As Long
    Dim xStr, xStrRg, xStrSheetname As String
    xRgArray = Array("A3;FTIR", "A4;Viscometer")
    On Error Resume Next
    For xFNum = LBound(xRgArray) To UBound(xRgArray)
    xStr = ""
    xStr = xRgArray(xFNum)
    xAValue = ""
    xAValue = Split(xStr, ";")
    xStrRg = ""
    xStrRg = xAValue(0)
    xStrSheetname = xAValue(1)
    If Not Intersect(Target, Range(xStrRg)) Is Nothing Then _
    Sheets(xStrSheetname).Active
    End If
    Next
    End Sub


    Many thanks
    • To post as a guest, your comment is unpublished.
      crystal · 15 days ago
      Hi Carl,
      In your code, please replace the first line with "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)".
      Thank you for your comment. The entire code should be as follows.

      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      Dim xArray, xAValue As Variant
      Dim xFNum As Long
      Dim xStr, xStrRg, xStrSheetName As String
      xRgArray = Array("A3;FTIR", "A4;Viscometer")
      On Error Resume Next
      For xFNum = LBound(xRgArray) To UBound(xRgArray)
      xStr = ""
      xStr = xRgArray(xFNum)
      xAValue = ""
      xAValue = Split(xStr, ";")
      xStrRg = ""
      xStrRg = xAValue(0)
      xStrSheetName = ""
      xStrSheetName = xAValue(1)
      If Not Intersect(Target, Range(xStrRg)) Is Nothing Then
      Sheets(xStrSheetName).Activate
      End If
      Next
      End Sub
  • To post as a guest, your comment is unpublished.
    Neil · 6 months ago
    Hi how can i extend my array? it stucks already and i cannot add more of this because it limits to col 1024 only for that line. pls help

    xRgArray = Array("A2;Sheet2", "A3;Sheet3", "A4;Sheet4", "A5;Sheet5")
    • To post as a guest, your comment is unpublished.
      crystal · 4 months ago
      Hi Neil,
      The code works well in my case even extended my array to Array = Array("A2;Sheet2", "A3;Sheet3", "A4;Sheet4", "A5;Sheet5", "A6;Sheet6").
      Can you tell me your Excel version?
  • To post as a guest, your comment is unpublished.
    James · 11 months ago
    After you get to the desired sheet. Is there a way to copy information from a cell in that sheet and automatically go back to the cell I double clicked on originally in the first sheet?
    • To post as a guest, your comment is unpublished.
      crystal · 10 months ago
      Hi James
      You need to manually click the original worksheet tab to back to it. Sorry can't take this into consideration.
  • To post as a guest, your comment is unpublished.
    Guest · 1 years ago
    Is there a way to do multiple codes for one tab? such as clicking on another cell to jump into another worksheet.

    How would that code look like?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Good day,

      The below VBA code can help you to solve the problem. Thanks for your comment.

      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      Dim xArray As Variant
      Dim xFNum As Long
      Dim xStr, xStrRg, xStrSheetName As String
      xRgArray = Array("A2;Sheet2", "A3;Sheet3", "A4;Sheet4", "A5;Sheet5")
      On Error Resume Next
      For xFNum = LBound(xRgArray) To UBound(xRgArray)
      xStr = ""
      xStr = xRgArray(xFNum)
      xStrRg = ""
      xStrRg = Left(xStr, 2)
      xStrSheetName = ""
      xStrSheetName = Right(xStr, Len(xStr) - 3)
      If Not Intersect(Target, Range(xStrRg)) Is Nothing Then
      Sheets(xStrSheetName).Activate
      End If
      Next
      End Sub
      • To post as a guest, your comment is unpublished.
        SG · 1 years ago
        Hi, In the line that states xStrRg = Left(xStr, 2), this picks up the cell if its a single number cell i.e. A1, A2, A3. but not if its A11, or A111. how do i write the code to allow me to use cells A1, A11, and A111?

        Hope this makes sense, i'm not particularly technical!!
        • To post as a guest, your comment is unpublished.
          crystal · 1 years ago
          Good Day,
          The code has been optimized again. Please have a try and thanks for your comment.

          Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
          Dim xArray, xAValue As Variant
          Dim xFNum As Long
          Dim xStr, xStrRg, xStrSheetName As String
          xRgArray = Array("A1;Sheet2", "A12;Sheet3", "A4;Sheet4", "A100;Sheet5")
          On Error Resume Next
          For xFNum = LBound(xRgArray) To UBound(xRgArray)
          xStr = ""
          xStr = xRgArray(xFNum)
          xAValue = ""
          xAValue = Split(xStr, ";")
          xStrRg = ""
          xStrRg = xAValue(0)
          xStrSheetName = ""
          xStrSheetName = xAValue(1)
          If Not Intersect(Target, Range(xStrRg)) Is Nothing Then
          Sheets(xStrSheetName).Activate
          End If
          Next
          End Sub