Tıkladığım Veriyi Saysın

[yeterpositif2024]

A:A hücresinde "c" ve "d" isimli 2 adet veri var. Mesela A:A Hücresinde "c" yazan herhangi bir hücreye tıkladığımda A:A hücresinde ne kadar "c" varsa B2 hücresine toplam "c" sayısını verecek bir kod için yardıma ihtiyacım var. teşekkürler.

 

[dEdE]

Merhaba,
Sayfanın kod bölümüne yapıştırarak dener misiniz?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
    Range("B2") = WorksheetFunction.CountIf(Range("A:A"), Target.Value)
End Sub

 

[yeterpositif2024]

çok teşekkürler işe yarıyor elinize sağlık. peki A:A hücresinde "c" yazan herhangi bir hücreye tıkladığımda, bu sefer b2 hücresi yerine sağındaki hücreye toplam "c" sayısını verebilmesi için nasıl bir kod eklemeliyim.

 

[yanginci34]

Günaydın Sayın dEdE nin kodunda ufak değişiklik yaptım denermisiniz

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target.Value <> "c" Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
    Target.Offset(0, 1).Value = WorksheetFunction.CountIf(Range("A:A"), "c")
End Sub

 

[yeterpositif2024]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("R:R")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
    Target.Offset(0, -1).Value = WorksheetFunction.CountIf(Range("R:R"), Target.Value)

If Intersect(Target, Range("S:S")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
    Target.Offset(0, 1).Value = WorksheetFunction.CountIf(Range("S:S"), Target.Value)
End Sub

dEdE ve yanginci34'ün kodlarını kullanarak istediğim şekilde entegre ettim hepinizin eline sağlık. şimdi şöyle bir sorun oluştu. R:R hücresindeki veriyi sola S:S hücresindeki veriyi sağa yazması için şöyle bir kod girdim fakat bu kod sadece R:R hücresindeki veriyi sola yazıyor S:S hücresindeki veriye tıkladığım zaman sağa yazmıyor bunun nedenini nedir? teşekkürler.

 

[dEdE]

Dener misiniz?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("R:R,S:S")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
    Target.Offset(0, -1).Value = WorksheetFunction.CountIf(Range("R:R"), Target.Value)
    Target.Offset(0, 1).Value = WorksheetFunction.CountIf(Range("S:S"), Target.Value)
End Sub

 

[Muzaffer Ali]

Alternatif 1

Private Sub sWorksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("R:R")) Is Nothing Then
        If Target.Cells.Count = 1 Then Target.Offset(0, -1).Value = WorksheetFunction.CountIf(Range("R:R"), Target.Value)
    ElseIf Not Intersect(Target, Range("S:S")) Is Nothing Then
        If Target.Cells.Count = 1 Then Target.Offset(0, 1).Value = WorksheetFunction.CountIf(Range("S:S"), Target.Value)
    End If
End Sub

Alternatif 2 Hücreye çift tıklayınca çalışır. (diğer kodu silmelisiniz)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    If Not Intersect(Target, Range("R:R")) Is Nothing Then
        If Target.Cells.Count = 1 Then Target.Offset(0, -1).Value = WorksheetFunction.CountIf(Range("R:R"), Target.Value)
    ElseIf Not Intersect(Target, Range("S:S")) Is Nothing Then
        If Target.Cells.Count = 1 Then Target.Offset(0, 1).Value = WorksheetFunction.CountIf(Range("S:S"), Target.Value)
    End If
End Sub

 

[yeterpositif2024]

hepinizin ellerine sağlık dostlar çok teşekkür ederim yardımcı olduğunuz için.