Hücrenin kendisini tek tık buton olarak kullanabilir miyim

[Akif59]

Merhaba biraz uğraştırıcı bir iş ama yardımlarınızı rica ediyorum

A5 hücresine her tek tıkladığımda C 21 C150 Aarasında gizli satırlardan bir satır açsın tık C22 tık C23 tık C24 Diye devam etsin
A5 çit tıklandığında ise C21 C150 Tamamını açsın

B5 hücresine her tek tıkladığımda da A5 in açtıklarını içeriğini silerek sondan başa doğru gizlesin C24 sil gizle C23 sil gizle C22 sil gizle gibi
B5 Çift tıklandığında-da tamamını silip gizlesin

 

[Korhan Ayhan]

Hücrenin tek tıklama (Selection) olayı biraz sıkıntılıdır. Bunun yerine buton kullanmanızı tavsiye ederim.

Çift tıklama için aşağıdaki kodu deneyebilirsiniz.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A5")) Is Nothing Then
        Cancel = True
        Range("C21:C150").EntireRow.Hidden = False
    End If
    If Not Intersect(Target, Range("B5")) Is Nothing Then
        Cancel = True
        Range("C21:C150").ClearContents
        Range("C21:C150").EntireRow.Hidden = True
    End If
End Sub

 

[Akif59]

Merhaba Sayın AYHAN
takibi butonda olur önemli olan kod yazılabilir mi olur u varmı dır bu tarz kodlar hepsi toplu göster gizle yapıyor

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub A5()
    Dim X As Byte
    For X = 21 To 150
        If Rows(X).Hidden = True Then
            Rows(X).Hidden = False
            Exit Sub
        End If
    Next
End Sub

Sub B5()
    Dim X As Byte
    For X = 15 To 21 Step -1
        If Rows(X).Hidden = False Then
            Range("C" & X).ClearContents
            Rows(X).Hidden = True
            Exit Sub
        End If
    Next
End Sub

 

[Akif59]

Deneyiniz.

Option Explicit

Sub A5()
    Dim X As Byte
    For X = 21 To 150
        If Rows(X).Hidden = True Then
            Rows(X).Hidden = False
            Exit Sub
        End If
    Next
End Sub

Sub B5()
    Dim X As Byte
    For X = 15 To 21 Step -1
        If Rows(X).Hidden = False Then
            Range("C" & X).ClearContents
            Rows(X).Hidden = True
            Exit Sub
        End If
    Next
End Sub

Merhaba Sayın AYHAN
sayfadaki Change koduna hata verdirmesinin nedeni ne olabilir fikriniz varmı dır sorunu nerede aramalıyım

 

[Korhan Ayhan]

Kod C sütununda silme işlemi yaptığı için Change olayını tetikliyor olabilir.

 

[Akif59]

Kod C sütununda silme işlemi yaptığı için Change olayını tetikliyor olabilir.

Sayın AYHAN
Haklısınız tetikliyor
Gece gece size zahmet veriyorum ama kodları modüle koyup sayfa 1 de butonla alıştırmak lazım bu durumda sizden ricam bu şekilde revize edebilir misiniz

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Son
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A5")) Is Nothing Then
        Cancel = True
        Range("C21:C150").EntireRow.Hidden = False
    End If
    If Not Intersect(Target, Range("B5")) Is Nothing Then
        Cancel = True
        Range("C21:C150").ClearContents
        Range("C21:C150").EntireRow.Hidden = True
    End If
Son: Application.EnableEvents = True
End Sub

 

[Akif59]

Deneyiniz.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Son
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A5")) Is Nothing Then
        Cancel = True
        Range("C21:C150").EntireRow.Hidden = False
    End If
    If Not Intersect(Target, Range("B5")) Is Nothing Then
        Cancel = True
        Range("C21:C150").ClearContents
        Range("C21:C150").EntireRow.Hidden = True
    End If
Son: Application.EnableEvents = True
End Sub

Sayın AYHAN
Gönülden teşekkür ederim sonuç başarılı