hücreye çift tıklama "doubleclick" ile rakam yazdırma

[sirkülasyon]

Hayırlı Cumalar, Hayırlı Sabahlar

E22 : E71 arasında herhangi bir hücreye çift tıklarsam "0" SIFIR
F22 : F71 arasında herhangi bir hücreye çift tıklarsam "1" BİR
G22 : G71 arasında herhangi bir hücreye çift tıklarsam "İKİ" İKİ
H22 : H71 arasında herhangi bir hücreye çift tıklarsam "3" ÜÇ
I22 : I71 arasında herhangi bir hücreye çift tıklarsam "4" DÖRT Yazacak.

Yalnız aynı satırda E22 : I22 arasında sadece bir rakama izin verecek.
örneğin E41 hücresine çift tık ile "0" sıfır rakamı yazıldı ama sonradan H41 hücresine çift tık yapıldığı zaman "0" silinecek "3" ÜÇ rakamı yazılacak.

Teşekkür eder saygılarımı sunarım.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("E22:E71")) Is Nothing Then
        Cancel = True
        Cells(Target.Row, "E").Resize(1, 5).ClearContents
        Target = 0
    ElseIf Not Intersect(Target, Range("F22:F71")) Is Nothing Then
        Cancel = True
        Cells(Target.Row, "E").Resize(1, 5).ClearContents
        Target = 1
    ElseIf Not Intersect(Target, Range("G22:G71")) Is Nothing Then
        Cancel = True
        Cells(Target.Row, "E").Resize(1, 5).ClearContents
        Target = 2
    ElseIf Not Intersect(Target, Range("H22:H71")) Is Nothing Then
        Cancel = True
        Cells(Target.Row, "E").Resize(1, 5).ClearContents
        Target = 3
    ElseIf Not Intersect(Target, Range("I22:I71")) Is Nothing Then
        Cancel = True
        Cells(Target.Row, "E").Resize(1, 5).ClearContents
        Target = 4
    End If
End Sub

 

[askm]

Aşağıdaki kodları sayfanın kod kısmına ekleyin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("E22:E71")) Is Nothing Then
    Target.Value = 0
End If
If Not Intersect(Target, Range("F22:F71")) Is Nothing Then
    Target.Value = 1
End If
If Not Intersect(Target, Range("G22:G71")) Is Nothing Then
    Target.Value = 2
End If
If Not Intersect(Target, Range("H22:H71")) Is Nothing Then
    Target.Value = 3
End If
If Not Intersect(Target, Range("I22:I71")) Is Nothing Then
    Target.Value = 4
End If
End Sub

 

[sirkülasyon]

Korhan Abi ve askm
ellerinize sağlık. teşekkür ederim