Preskoči na glavno vsebino

Kako dvoklikniti celico, da odprete določen delovni list v Excelu?

Ali se želite hitro pomakniti do določenega delovnega lista v Excelovem delovnem zvezku? Ta članek vsebuje metodo VBA za odpiranje določenega delovnega lista z dvoklikom določene celice v Excelu.

Dvokliknite celico, da odprete določen delovni list s kodo VBA

Dvokliknite celico, da odprete določen delovni list s kodo VBA

Naredite naslednji postopek, da odprete določen delovni list tako, da dvokliknete celico v Excelu.

1. Z desno miškino tipko kliknite zavihek lista, ki vsebuje celico, ki jo želite odpreti, tako da ga kliknete. In nato kliknite Ogled kode iz kontekstnega menija. Oglejte si posnetek zaslona:

2. Na odprtju Microsoft Visual Basic za aplikacije okno, kopirajte naslednjo kodo VBA v okno Code.

Koda VBA: dvokliknite celico, da odprete določen delovni list v Excelu

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

Opombe: V kodi VBA, "A1; list 2""A12; list 3""A4; list 4""A100; list 5" pomeni, da dvojni klik na celico A1 odpre Sheet2, dvoklik A2 pa bo odprl Sheet3 ..., spremenite jih glede na vaše potrebe.

3. Pritisnite druga + Q tipke, da zaprete Microsoft Visual Basic za aplikacije okno.

Od zdaj naprej, ko dvokliknete celico A1 na trenutnem delovnem listu, bo navedeni delovni list takoj aktiviran.

Sorodni članki:

Najboljša pisarniška orodja za produktivnost

🤖 Kutools AI Aide: Revolucionirajte analizo podatkov na podlagi: Inteligentna izvedba   |  Ustvari kodo  |  Ustvarite formule po meri  |  Analizirajte podatke in ustvarite grafikone  |  Prikličite funkcije Kutools...
Priljubljene funkcije: Poiščite, označite ali identificirajte dvojnike   |  Izbriši prazne vrstice   |  Združite stolpce ali celice brez izgube podatkov   |   Krog brez formule ...
Super iskanje: Več kriterijev VLookup  |   Multiple Value VLookup  |   VLookup na več listih   |   Nejasno iskanje ....
Napredni spustni seznam: Hitro ustvarite spustni seznam   |  Odvisni spustni seznam   |  Večkrat izberite spustni seznam ....
Upravitelj stolpcev: Dodajte določeno število stolpcev  |  Premakni stolpce  |  Preklop stanja vidnosti skritih stolpcev  |  Primerjaj obsege in stolpce ...
Predstavljene funkcije: Mrežni fokus   |  Pogled oblikovanja   |   Velika vrstica formule   |  Upravitelj delovnih zvezkov in listov   |  Knjižnica virov (Samodejno besedilo)   |  Izbirnik datuma   |  Združite delovne liste   |  Šifriranje/dešifriranje celic   |  Pošljite e-pošto po seznamu   |  Super filter   |   Poseben filter (filter krepko/ležeče/prečrtano ...) ...
15 najboljših kompletov orodij:  12 Besedilo Orodja (dodajanje besedila, Odstrani znake,...)   |   50 + Graf Vrste (Gantt Chart,...)   |   40+ Praktično Formule (Izračunajte starost glede na rojstni dan,...)   |   19 vstavljanje Orodja (Vstavite kodo QR, Vstavi sliko s poti,...)   |   12 Pretvorba Orodja (Številke v besede, Pretvorba valut,...)   |   7 Spoji in razdeli Orodja (Napredne kombinirane vrstice, Razdeljene celice,...)   |   ... in več

Napolnite svoje Excelove spretnosti s Kutools za Excel in izkusite učinkovitost kot še nikoli prej. Kutools za Excel ponuja več kot 300 naprednih funkcij za povečanje produktivnosti in prihranek časa.  Kliknite tukaj, če želite pridobiti funkcijo, ki jo najbolj potrebujete...

Opis

Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo

  • Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
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