DoubleClick

[1Al2Ver]

İyi akşamlar,

Data(I) isimli sayfada B3:B30 aralığında isimler , C3:V3 aralığında ise rumuzlar ( M, K, Z ve benzeri ) mevcut, ben bu rumuzları manuel renklendiriyorum,

Kod ile B3:B30 aralığında kayıtlı bir ismin sağındaki bir hücreyi çift tıkladığımda, (örneğin C3) tıklanan hücrenin rengi, Tablo(I) isimli sayfada gerekli ismin (B3) sağındaki ilgili hücreye (C3) taşınıyor.

Aşağıdaki kod ise hücre çift tıklandığında formüllü hücreler hariç satırları silmekte,

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error GoTo hata
ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants, 23) = vbNullString
Target.Offset(1).Select
hata:
End Sub

Yapmak istediğim ;

İki DoubleClick olayını aynı sayfada (Data(I)) kullanabilmek,

Teşekkür ederim.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin. Silme işlemini sadece A veya B sütununa çift tıklayınca yapacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Intersect(Target, [a:b]) Is Nothing Then
ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants, 23) = vbNullString
Target.Offset(1).Select
End If
    If Intersect(Target, [C3:V30]) Is Nothing Then Exit Sub
    Dim SD As Object, SAT As Object
    Dim BUL As Range, SÜTUN As Byte
    Set SD = Sheets("DATA(I)")
    Set SAT = Sheets("TABLO(I)")
    Set BUL = SAT.[B:B].Find(Cells(Target.Row, 2), , xlValues)
    If Not BUL Is Nothing Then
    If Target.Interior.ColorIndex <> xlNone Then
    Cancel = True
    Select Case Target.Column
        Case Is = 3
        SAT.Cells(BUL.Row, "C").Interior.ColorIndex = Target.Interior.ColorIndex
        Case Is > 3
        SÜTUN = Target.Column + ((Target.Column - 3) * 5)
        SAT.Cells(BUL.Row, SÜTUN).Interior.ColorIndex = Target.Interior.ColorIndex
    End Select
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
    Else
    MsgBox Cells(Target.Row, 2) & "  ismi bulunamamıştır." & Chr(10) & "Lütfen kontrol ediniz !", vbExclamation, "Dikkat !"
    End If
End Sub

 

[1Al2Ver]

Aşağıdaki gibi deneyin. Silme işlemini sadece A veya B sütununa çift tıklayınca yapacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Intersect(Target, [a:b]) Is Nothing Then
ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants, 23) = vbNullString
Target.Offset(1).Select
End If
    If Intersect(Target, [C3:V30]) Is Nothing Then Exit Sub
    Dim SD As Object, SAT As Object
    Dim BUL As Range, SÜTUN As Byte
    Set SD = Sheets("DATA(I)")
    Set SAT = Sheets("TABLO(I)")
    Set BUL = SAT.[B:B].Find(Cells(Target.Row, 2), , xlValues)
    If Not BUL Is Nothing Then
    If Target.Interior.ColorIndex <> xlNone Then
    Cancel = True
    Select Case Target.Column
        Case Is = 3
        SAT.Cells(BUL.Row, "C").Interior.ColorIndex = Target.Interior.ColorIndex
        Case Is > 3
        SÜTUN = Target.Column + ((Target.Column - 3) * 5)
        SAT.Cells(BUL.Row, SÜTUN).Interior.ColorIndex = Target.Interior.ColorIndex
    End Select
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
    Else
    MsgBox Cells(Target.Row, 2) & "  ismi bulunamamıştır." & Chr(10) & "Lütfen kontrol ediniz !", vbExclamation, "Dikkat !"
    End If
End Sub

Sayın Levent Menteşoğlu, merhaba,

Çözüm için çok teşekkür ederim,

1) Kodun silebileceği satır sayısı kısıtlı mı ?

Data(I) sayfasına bağlı olarak Tablo(I) sayfasındaki veriler EX kolonuna kadardır,

Data(I) sayfasındaki B3 çift tıklanınca Tablo(I)'de DV kolonuna kadarki veriler silindi, aynı karaktere sahip diğerleri (DW:EX)'i de silmek için gereken ne olabilir ?

2) Ayrıca A veya B çift tıklanınca sadece ilgili satırı (C:EX) silen kodu rica edebilirmiyim ?

Saygılarımla