Üstteki Hücreyi Çift Tıklayınca Alt Tarafı Silme Makrosu Düzenleme.. Yardım..

[smaeler]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [W1:BA1]) Is Nothing Then Exit Sub
Dim Cevap As Integer
Dim Mesaj As String
Dim Baslik As String
Mesaj = "" & Target.Value & " Tarihli Ekders Verileri Silinsin mi?"
Baslik = "Günlük Ekders Veri Sil"
Cevap = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)
If Cevap = vbNo Then End

If Target.Column = 23 Then
Range("=W4:W40").ClearContents
Range("W3").Select

ElseIf Target.Column = 24 Then
Range("X4:X40").ClearContents
Range("X3").Select
..............

Şeklinde Üstteki Hücreyi Çift Tıklayınca Alt Tarafı Silen bir VBA kodum var. Bu kod ile 5 sütunda çalışıyorum. Bunu yaklaşık olarak 30 Sütun ile çalışacağım. Tek tek uğraşmak zor oluyor. Bunu W-BA sütunları arasında TEK KOD ile yapmak istiyorum. Yardımlarınızı Bekliyorum.

 

[volki_112]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [W1:BA1]) Is Nothing Then Exit Sub
Dim Cevap As Integer
Dim Mesaj As String
Dim Baslik As String
Mesaj = "" & Target.Value & " Tarihli Ekders Verileri Silinsin mi?"
Baslik = "Günlük Ekders Veri Sil"
Cevap = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)
If Cevap = vbNo Then End

If Target.Column = 23 Then
Range("=W4:W40").ClearContents
Range("W3").Select

ElseIf Target.Column = 24 Then
Range("X4:X40").ClearContents
Range("X3").Select
..............

Şeklinde Üstteki Hücreyi Çift Tıklayınca Alt Tarafı Silen bir VBA kodum var. Bu kod ile 5 sütunda çalışıyorum. Bunu yaklaşık olarak 30 Sütun ile çalışacağım. Tek tek uğraşmak zor oluyor. Bunu W-BA sütunları arasında TEK KOD ile yapmak istiyorum. Yardımlarınızı Bekliyorum.

kendi kodunuzda uygun yere yerleştirin. W ve BA sütunları arasında çift tıklarsanız tıkladığınız sütunda 4:40 satır arasını siler

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Çift tıklanan hücre W1 ile BA1 aralığında değilse prosedürü sonlandır
    If Intersect(Target, Me.Range("W1:BA1")) Is Nothing Then Exit Sub

    Dim Cevap As Integer
    Dim Mesaj As String
    Dim Baslik As String
    Dim SilinecekSutun As String

    ' Çift tıklanan sütunun harfini al
    SilinecekSutun = Split(Target.Address, "$")(1)

    Mesaj = "" & Target.Value & " Tarihli Ekders Verileri Silinsin mi?"
    Baslik = "Günlük Ekders Veri Sil"
    Cevap = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)

    ' Kullanıcı "Hayır" seçeneğini seçtiyse prosedürü sonlandır
    If Cevap = vbNo Then Exit Sub

    ' Belirlenen sütunun 4 ile 40 arasındaki hücrelerini temizle
    Me.Range(SilinecekSutun & "4:" & SilinecekSutun & "40").ClearContents

    ' Aynı sütunun 3. satırını seç
    Me.Range(SilinecekSutun & "3").Select

    ' Çift tıklama olayının varsayılan davranışını engelle (hücreye girme vb.)
    Cancel = True
End Sub

 

[muhasebeciyiz]

Alternatif olsun

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    If Intersect(Target, Range("W1:BA1")) Is Nothing Then Exit Sub
    
    Dim Cevap As Integer
    Dim Mesaj As String
    Dim Baslik As String
    
    Mesaj = "" & Target.Value & " Tarihli Ekders Verileri Silinsin mi?"
    Baslik = "Günlük Ekders Veri Sil"
    Cevap = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)
    
    If Cevap = vbNo Then Exit Sub
    
    
    Range(Cells(4, Target.Column), Cells(40, Target.Column)).ClearContents
    Cells(3, Target.Column).Select
  
    Cancel = True
End Sub

Bu kod, W1:BA1 aralığındaki herhangi bir hücreye çift tıkladığınızda o sütunun 4-40 arasındaki verilerini silecektir. 30 sütun için ayrı ayrı kod yazmanıza gerek kalmadan, tek bir kodla tüm aralığı kapsar.

 

[smaeler]

Her iki kod da çalıştı. Teşekkürler.. Çok Kolay Oldu ve İyi Çalışıyor..