Çift Tıklama ile makro tetikleme için destek

[Tevfik_Kursun]

Merhaba Arkadaşlar,
B4:B5 arası çift tıklandığında hizasındaki A hücresinde adının soldan ilk harfi olan sayfalar görünür oluyor
C4:C5 arası çift tıklandığında hizasındaki A hücresinde adının soldan ilk harfi olan sayfalar gizlenmiş oluyor
A7:A15 arası dinamik
B7:B15 arası çift tıklandığında hizasındaki A hücresinde adı bulunan sayfa görünür oluyor
C7:C15 arası çift tıklandığında hizasındaki A hücresinde adı bulunan sayfa gizlenmiş oluyor
Bu işlemler için 22 farklı makro kullandım. Daha pratik hale getirmenin bir yolu var mıdır?
Saygılarımla

 

[veyselemre]

Sayfanın kod kısmına;

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    Dim aK As Boolean
    If Target.Column = 2 Then aK = True Else aK = False
    If Target.Column = 2 Or Target.Column = 3 Then
        If Target.Row = 4 Or Target.Row = 5 Then
            Call sayfaGosterGizle(Cells(Target.Row, 1).Value, aK)
        ElseIf Target.Row > 6 And Target.Row < 16 Then
            Call sayfaGosterGizle(Cells(Target.Row, 1).Value, aK)
        End If
    End If
End Sub

Module

Sub sayfaGosterGizle(s As String, aK As Boolean)
    Dim i
    For i = 1 To Worksheets.Count
        If Sheets(i).Name Like s & "*" Then Sheets(i).Visible = aK
    Next i
    Sheets("Data").Select
End Sub

 

[Tevfik_Kursun]

Sayın Veysel Emre Hocam,
Çok teşekkür ederim, beni büyük bir yükten kurtardınız

ElseIf Target.Row > 6 And Target.Row < 16 Then

bu satırdaki 16 yı otomatik algılayabilir mi?
Saygılarımla

 

[Tevfik_Kursun]

Otomatik algıladı, tekrar teşekkür ederim.
Saygılarımla

 

[veyselemre]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    If Target.Column = 2 Or Target.Column = 3 Then
        Dim aK As Boolean, s$
        If Target.Column = 2 Then aK = True Else aK = False
        Select Case Target.Row
            Case 4, 5: s = Cells(Target.Row, 1).Value & "*"
            Case Is > 6: s = Cells(Target.Row, 1).Value
        End Select
        If s <> "" Then Call sayfaGosterGizle(s, aK)
    End If
End Sub

Sub sayfaGosterGizle(s As String, aK As Boolean)
    If s <> "" Then
        If InStr(s, "*") Then
            Dim i
            For i = 1 To Worksheets.Count
                If Sheets(i).Name Like s Then Sheets(i).Visible = aK
            Next i
        Else
            If Evaluate("ISREF('" & s & "'!A1)") = True Then Sheets(s).Visible = aK
        End If
    End If
    Sheets("Data").Select
End Sub

 

[Tevfik_Kursun]

Sayın Veysel Emre Hocam,
Tekrar çok teşekkür ederim, sayfa sayısını sayarak olmuş.
Saygılarımla