• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

100'den fazla sheet olan excel'de sheet seçme makrosu

  • Konbuyu başlatan Konbuyu başlatan oussp
  • Başlangıç tarihi Başlangıç tarihi
Katılım
13 Aralık 2006
Mesajlar
11
Excel Vers. ve Dili
EXCEL 2003 İNGİLİZCE
Arkadaşlar merhaba;

Yaklaşık 200 sheet'lik bir excel dosyasında hergün çalışmak durumundayım; fakat, sheet'leri bulurken oldukça zorluk çekiyorum. Bunun için aklıma gelen şu oldu. Macroda play'e bastığımda bir message box açılsa ve içine sheet name'i yazsam ve OK dediğimde beni o sheet'e götürse. Bu mümkün müdür acaba? Yardımlarınız için çok teşekkür ederim. Sağolun. Excel dosyası forum limitlerini aştığı için dosyayı ekleyemedim. Teorik olarak 10 sayfalık bir excelde de bu örneği yapsak olabilir değil mi ? Tekrar teşekkürler yardımlarınız için arkadaşlar.
 
Sayfa Seçme

Merhaba,

Aşağıdaki kodları WorkBook'un kod bölümüne kopyalayınız.

Herhangi bir sayfada Çift Tıklayıp sonucu görünüz.

Kod:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
Sayfa = InputBox("Sayfa Adını Giriniz", "Sayfa Seçme")
If Sayfa <> "" Then Sheets(Sayfa).Select
Son:
End Sub
 
Son düzenleme:
Soruyu tam anlamam&#305;&#351;&#305;m Sn Necdet_Yesertener &#246;nerisi daha do&#287;ru
 
Yat&#305;&#287;&#305;m bo&#351;a gitmesin yukardaki &#246;rne&#287;i de&#287;i&#351;tirdim. form herhangi sayfayada herhangi bir h&#252;creye &#231;ift t&#305;klay&#305;nca &#231;&#305;k&#305;yor. Sn Necdet_Yesertener &#246;rne&#287;indeki gibi
 
Bir örnekte benden.:cool:
 
Arkadaşlar cevaplarınız için çok teşekkürler, çalışmaların hepsini tek tek denedim. Necdet Bey'in ve Ömer Bey'in yöntemlerini ayrı ayrı uyguladım ve şu an ikisini de dosyalarımda kullanmaya başladım. Çok teşekkür ederim. Ayrıca son gelen linkte geliştirilebilir özellikler var, bunları da okuyacağım. Tekrar sağolun, görüşmek üzere. Ben de sizler gibi yetkin olup arkadaşlara yardımcı olmak istiyorum, bakalım ne zaman olacak.
 
Merhaba,

Form kullanmadan daha pratik olduğunu düşündüğüm çözümü sunuyorum. Aklıma takılmıştı, aklımda kalacağına forumda kalsın :)

Kod:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If ActiveSheet.Name <> "Ana Sayfa" Then
    Sheets("Ana Sayfa").Select
ElseIf Target.Value <> "" Then
    Sheets(Target.Value).Select
End If
Son:
End Sub
 
Teşekkürler Sayın htrk,

Biraz daha geliştireyim dedim ve sayfa yoksa açsın istedim.

Kod:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If ActiveSheet.Name <> "Ana Sayfa" Then
    Sheets("Ana Sayfa").Select
ElseIf Target.Value <> "" Then
    Sheets(Target.Value).Select
End If
Exit Sub
Son:
Sordum = MsgBox(Target.Value & " Adlı Sayfa Yok, Eklemek İster Misiniz? ", vbYesNo, Target.Value & " Adlı Sayfanın Açılması")
If Sordum = vbYes Then
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Target.Value
    MsgBox Target.Value & " Sayfası AÇILDI......", vbOKOnly, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End If
End Sub
 
Biraz daha geli&#351;tireyim dedim ve sayfa yoksa a&#231;s&#305;n istedim.

Say&#305;n Yesertener, her ikisi de s&#252;per olmu&#351;, ellerinize sa&#287;l&#305;k, sayg&#305;lar&#305;mla.
 
Sn. Necdet_Yesertener

Tekrar tekrar ellerinize sa&#287;l&#305;k.. Yeni sayfa a&#231;ma i&#351;lemi yap&#305;l&#305;rken a&#231;&#305;lan sayfan&#305;n en sona de&#287;ilde alfabetik s&#305;rada eklenmesi m&#252;mk&#252;nm&#252;d&#252;r?

Te&#351;ekk&#252;rler..
 
Necdet Bey gerçekten çok teşekkürler süper olmuş. Arkadaşın sorduğu gibi tüm sayfaları alfabetik düzen içinde sıralaması da mümkün müdür hem yeni ekledikleri mi hem de hali hazırda bulunan sayfaları? Çok teşekkürler tekrar.
 
Merhaba,

Sayfa ekledikten sonra sıralama işlemini de yapan hali :

Kod:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If ActiveSheet.Name <> "Ana Sayfa" Then
    Sheets("Ana Sayfa").Select
ElseIf Target.Value <> "" Then
    Sheets(Target.Value).Select
End If
Exit Sub
Son:
Sordum = MsgBox(Target.Value & " Adlı Sayfa Yok, Eklemek İster Misiniz? ", vbYesNo, Target.Value & " Adlı Sayfanın Açılması")
If Sordum = vbYes Then
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Target.Value
    MsgBox Target.Value & " Sayfası AÇILDI......", vbOKOnly, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
                    
    If Worksheets.Count > 2 Then
        For i = 2 To Worksheets.Count - 1
            For j = 3 To Worksheets.Count
                If Worksheets(j).Name < Worksheets(i).Name Then
                   Worksheets(j).Move before:=Worksheets(i)
                End If
            Next j
        Next i
    End If
End If
End Sub
 
Sayfalar&#305;n alfabetik d&#252;zenleme kodu a&#351;a&#287;&#305;dad&#305;r.
Benim sordu&#287;um soru ikisinin birle&#351;imi gibi ama nas&#305;l..

Sub Bicim_SayfaDiz()
Dim Sht1 As Worksheet, Sht2 As Worksheet
For Each Sht1 In Worksheets
For Each Sht2 In Worksheets
If Sht1.Name > Sht2.Name Then Sht1.Move after:=Sht2
Next Sht2
Next Sht1
CreateObject("WScript.Shell").Popup _
"SAYFALAR SIRALANDI..!", 1, "UYARI", vbInformation
End Sub
 
Sn. Necdet bey mesaj&#305;n&#305;z&#305; g&#246;rmemi&#351;tim ama &#231;ok sayfa var bu y&#252;zden uzun s&#252;r&#252;yor, &#246;nceki kodunuzun i&#231;inde bulup eklemesi m&#252;mk&#252;nm&#252;?
 
Sayın çözümleriniz harika.Ama bir güzellik daha var orda renkli açıklama penceresi.Peki onu nasıl yapabiliriz?Teşekkürler.
 
Renkli a&#231;&#305;klama penceresi?
 
merhaba Necdet Bey,

eklemiş olduğunuz örnek zip dosyasını indiremiyorum.
Rica etsem tekrar yükleyebilirmisiniz?

Merhaba,

Aşağıdaki kodları WorkBook'un kod bölümüne kopyalayınız.

Herhangi bir sayfada Çift Tıklayıp sonucu görünüz.

Kod:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
Sayfa = InputBox("Sayfa Adını Giriniz", "Sayfa Seçme")
If Sayfa <> "" Then Sheets(Sayfa).Select
Son:
End Sub
 
Geri
Üst