Прескочи на основното съдържание

Как да щракнете двукратно върху клетка, за да отворите определен работен лист в Excel?

Автор: Силувия Последна промяна: 2020-07-09

Искате ли бързо да навигирате до определен работен лист в работна книга на Excel? Тази статия ще предостави метод на VBA за отваряне на определен работен лист чрез двукратно щракване върху определена клетка в Excel.

Щракнете два пъти върху клетка, за да отворите определен работен лист с VBA код

Щракнете два пъти върху клетка, за да отворите определен работен лист с VBA код

Моля, направете следното, за да отворите определен работен лист, като щракнете двукратно върху клетка в Excel.

1. Щракнете с десния бутон върху раздела на листа, който съдържа клетката, която искате да отворите, като щракнете върху него. И след това щракнете Преглед на кода от контекстното меню. Вижте екранна снимка:

2. В откриването Microsoft Visual Basic за приложения прозорец, моля, копирайте следния 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;Лист2""A12;Лист3""A4;Лист4""A100;Лист5" означава, че двойно щракване върху клетка A1 ще отвори Sheet2, двойно щракване върху A2 ще отвори Sheet3..., моля, променете ги въз основа на вашите нужди.

3. Натисни Друг + Q ключовете заедно, за да затворите Microsoft Visual Basic за приложения прозорец.

Отсега нататък, когато щракнете двукратно върху клетка A1 в текущия работен лист, посоченият работен лист ще се активира незабавно.

Свързани членове:

Най-добрите инструменти за продуктивност в офиса

🤖 Kutools AI помощник: Революционизирайте анализа на данни въз основа на: Интелигентно изпълнение   |  Генериране на код  |  Създаване на персонализирани формули  |  Анализирайте данни и генерирайте диаграми  |  Извикване на функциите на Kutools...
Популярни функции: Намерете, маркирайте или идентифицирайте дубликати   |  Изтриване на празни редове   |  Комбинирайте колони или клетки без загуба на данни   |   Кръг без формула ...
Супер търсене: VLookup с множество критерии  |   VLookup с множество стойности  |   VLookup в няколко листа   |   Размито търсене ....
Разширен падащ списък: Бързо създаване на падащ списък   |  Зависим падащ списък   |  Падащ списък с множество избори ....
Мениджър на колони: Добавете конкретен брой колони  |  Преместване на колони  |  Превключване на състоянието на видимост на скритите колони  |  Сравнете диапазони и колони ...
Препоръчани функции: Мрежов фокус   |  Изглед на дизайна   |   Голям формула бар   |  Мениджър на работни книги и листове   |  Библиотека с ресурси (Автоматичен текст)   |  Избор на дата   |  Комбинирайте работни листове   |  Шифроване/декриптиране на клетки   |  Изпращайте имейли по списък   |  Супер филтър   |   Специален филтър (филтър получер/курсив/зачертано...) ...
Топ 15 комплекта инструменти:  12 Текст Инструменти (добавяне на текст, Премахване на символи, ...)   |   50 + Графика Видове (диаграма на Гант, ...)   |   40+ Практичен формули (Изчислете възрастта въз основа на рождения ден, ...)   |   19 вмъкване Инструменти (Въведете QR код, Вмъкване на картина от пътя, ...)   |   12 Конверсия Инструменти (Числа към думи, Валутен обмен, ...)   |   7 Обединяване и разделяне Инструменти (Разширено комбиниране на редове, Разделени клетки, ...)   |   ... и още

Усъвършенствайте уменията си за Excel с Kutools за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време.  Щракнете тук, за да получите функцията, от която се нуждаете най-много...

Описание

Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна

  • Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
  • Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
  • Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!
Comments (14)
No ratings yet. Be the first to rate!
Will
Will
This comment was minimized by the moderator on the site
Can't get the code to open the other worksheet
Reply
0
0
crystal
crystal     Will
This comment was minimized by the moderator on the site
Hi Will,Is there any prompts while using the code?
Reply
Report
0
0
Wilbertmosley
Wilbertmosley
This comment was minimized by the moderator on the site
Can't get code to open the other sheet, can some help
Reply
0
0
vera
vera
This comment was minimized by the moderator on the site
hi!
It cannot accept the code for more than 59 sheets.
What code do i need to use to insert more sheets.
When it change the line the code doesnt work.
Help!
Reply
0
0
Carl
Carl
This comment was minimized by the moderator on the site
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
Reply
0
0
crystal
crystal     Carl
This comment was minimized by the moderator on the site
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
Reply
Report
0
0
neil04
neil04
This comment was minimized by the moderator on the site
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")
Reply
Report
0
0
crystal
crystal     neil04
This comment was minimized by the moderator on the site
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?
Reply
Report
0
0
James
James
This comment was minimized by the moderator on the site
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?
Reply
0
0
crystal
crystal     James
This comment was minimized by the moderator on the site
Hi James
You need to manually click the original worksheet tab to back to it. Sorry can't take this into consideration.
Reply
Report
0
0
Guest
Guest
This comment was minimized by the moderator on the site
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?
Reply
0
0
crystal
crystal     Guest
This comment was minimized by the moderator on the site
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
Reply
Report
0
0
SG
SG     crystal
This comment was minimized by the moderator on the site
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!!
Reply
0
0
crystal
crystal     SG
This comment was minimized by the moderator on the site
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
Reply
Report
0
0
There are no comments posted here yet
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations