MAKRO İLE EĞERSAY + TOPLA

[coşkun79]

Sub TEST_1()
If Range("A1") <> "" Then
Range("F4").Value = WorksheetFunction.CountIf(Range("A4:E4"), [A1])
End If
End Sub

Normalde formül ile yaptığım bir işlemi makro ile yapmaya çalışıyorum.
İlk satırdaki sayıları A4:E4 gibi bütün satırlarda tek tek saydırıp toplamaya ve sonra F4'den itibaren aşağı doğru yazdırmaya çalışıyorum. Yukarıdaki şekilde kod denemesi yaptım ama sadece A1 hücre değerini saydırabiliyorum. Gerisini nasıl yazabilirim?
Dosyanın içinde olması gereken doğru sonuçları yazdım. Dosyaya bakınca konu daha iyi anlaşılacaktır.

 

[Ziynettin]

Sub TEST_1()
If Range("A1") <> "" Then
    son_satir = [A:E].Find("?", , , , xlByRows, xlPrevious).Row
    If son_satir > 3 Then
        For i = 4 To son_satir
            Range("F" & i).Value = WorksheetFunction.CountIf(Range("A" & i & ":E" & i), [A1])
        Next i
    End If
End If
End Sub

 

[coşkun79]

Sayın Ziynettin, teşekkür ederim. Ama sadece A1 hücresini saydırmışsınız. Bunun yanında içinde değer olan b1;c1;d1;e1 hücrelerini de saydırıp sonra bunları toplamaya çalışıyorum. Doğru sonuçlar G sütununda mevcut. G sütununda formül de var. Tekrar bakabilir misiniz

 

[Ziynettin]

Sub TEST_1()
If Range("A1") <> "" Then
    son_satir = [A:E].Find("?", , , , xlByRows, xlPrevious).Row
    If son_satir > 3 Then
        For i = 4 To son_satir
            For j = 1 To 5
                topla = topla + WorksheetFunction.CountIf(Range("A" & i & ":E" & i), Cells(1, j))
            Next j
            Range("F" & i).Value = topla
            topla = 0
        Next i
    End If
End If
End Sub

 

[coşkun79]

Sayın Ziynettin, teşekkür ederim. Elinize sağlık

 

[coşkun79]

Yukarıdaki kodu farklı bir senaryo ile ifade etmek mümkün mü? Şöyle ki;
Ekli dosyanın B sayfası A:E aralığındaki her bir satırda yer alan veriler liste sayfasındaki sütunlarda sayılıyor. ( bu sefer satır değil)
Ben doğru sonuçları B sayfası I:K sütunlarında formül ile gösterdim. Makro sonuçlarının yazılacağı alanı ise F:H sütunları olarak kırmızı ile işaretledim.
Emek veren herkese teşekkürler.

 

[Ziynettin]

Dosyanız ekte.

 

[coşkun79]

Harika.Tekrardan elinize sağlık.