Şartlı say makrosu

[gertt]

Merhaba.
Belirlenen şartlara bağlı değer say makrosunu nasıl yazabiliriz? Örnek dosyayı ekledim.

 

[İhsan Tank]

Merhaba.
Belirlenen şartlara bağlı değer say makrosunu nasıl yazabiliriz? Örnek dosyayı ekledim.

merhaba
BC sütunundaki saydırma için

Sub sayalım()
Dim i As Long
Dim a As Integer
i = Cells(65536, "C").End(xlUp).Row
For a = 5 To i
Cells(a, "BC") = WorksheetFunction.CountA(Range("E" & a & ":" & "BB" & a))
Next a
End Sub

bu işinizi görür sanırım.
diğer sorunuzu tam anlayamadım

 

[gertt]

İhsan bey, merhaba.İlginiz için tekrar teşekkürler.Anlaşılamayan kısmı başka türlü izah etmeye çalışayım:A1,B1 ve C1'de 1'den 50 sayısına kadar sayılarımız olabilir.Ama A1,B1 ve C1'deki sayıların toplamı 50 sayısını geçemez.İşlemler E5 ile BB sütunları arasında olacak ve her satırdaki D harflerinin toplamı yapılacak.Toplam yapılırken;1) E1 hücresinden başlayıp A1 hücresindeki sayının değeri kadar (Örneğin;A1 hücresinde 10 sayısı varsa E5 ile N5 arası )sağ taraftan E5,F5,G5,.... hücrelerinden D harflerini BD5 hücresine toplatmak.2) B1 hücresinde örneğin 30 sayısı varsa O5 den başlayıp 30 hücre sağ taraf (1. maddede değerlendirmeye tabi olan veri aralığının bittiği yerden başlayacak.)yani O5 ile AR5 hücreleri arasındaki D harflerinin toplamının BE5 hücresine toplatmak.3) C1 hücresinde örneğin 10 sayısı varsa AS5 den başlayıp 10 hücre sağ taraf (2. maddede değerlendirmeye tabi olan veri aralığının bittiği yerden başlayacak.)yani AS5 ile BB5 hücreleri arasındaki D harflerinin toplamının BF5 hücresine toplatmak.
A1,B1 ve C1 deki sayılar sabit olsaydı verdiğiniz kodla bu sorun çok rahat halledilebilirdi.Ancak bu hücrelerdeki sayılar değişebiliyor.Teşekkürler...

 

[İhsan Tank]

arkadaşım bunu dosya üzerinde elle yaparak açıklar mısınız ve lütfen sorularınızı tek tek sorunuz.
1. si tamam
2. işlemi dosya üzerinde yapın ve şu olmalı diye yazın işlemlerinizi yapmaya çalışayım. bu şekilde çok karmaşık duruyor

 

[gertt]

İhsan bey dosya üzerinde tekrar izah etmeye çalıştım.Dosyayı ekledim.

 

[Ömer]

Merhaba,

* 5. satırda bu istedikleriniz olduktan sonra, aynı sorgulamayı 6., 7., .......satırlarada da aynı şekilde devam mı ettirilecek?

* Bu durumda F1 hücresi 50 den büyük olamayacak sanırım.

* Formülle mi yoksa makroyla mı yapılacak ?

.

 

[gertt]

Ömer bey,merhaba.
*Sorgulama 6.,7.,........... satırlar için de geçerlidir.
*Ben sadece A1,B1 ve C1 hücresindeki sayıların toplamının 50 sayısından büyük olmayacağını göstermek için F1 hücresine A1,B1,C1 in toplamlarını aldım.Buranın bir önemi yok.
*Makroyla yapılacak.
*Bir de A1 hücresinde sayı yoksa veya değer 0 ise BD sütununda hücrelerin boş göstermesi,
B1 hücresinde sayı yoksa veya değer 0 ise BE sütununda,C1 hücresinde sayı yoksa veya değer 0 ise BD sütununda hücrelerin boş göstermesi gerekiyor.
Teşekkürler...

 

[Ömer]

Bence formül kullanmanız daha mantıklı olurdu. Tabi tercih sizin...

Module kopyalarak çalıştırınız.

Option Compare Text
 
Sub bUlSay()
 
Dim i As Long, son As Long
Dim a As Integer, b As Integer, c As Integer, ilk As Integer
Dim Wf
 
a = Range("A1").Value
b = Range("B1").Value
c = Range("C1").Value
 
If a + b + c > 50 Then
    MsgBox "Kontrol Sayılarını Gözden Geçirin"
    Exit Sub
End If
 
Set Wf = WorksheetFunction
son = Cells(Rows.Count, "A").End(xlUp).Row
ilk = 5
 
Range("BB5:BF" & son).ClearContents
 
For i = ilk To son
    If Range("A1") <> "" Then Cells(i, "BD") = Wf.CountIf(Range(Cells(i, ilk), _
                        Cells(i, a + ilk - 1)), "d")
    If Range("B1") <> "" Then Cells(i, "BE") = Wf.CountIf(Range(Cells(i, ilk + a), _
                        Cells(i, a + b + ilk - 1)), "d")
    If Range("C1") <> "" Then Cells(i, "BF") = Wf.CountIf(Range(Cells(i, ilk + a + b), _
                        Cells(i, a + b + c + ilk - 1)), "d")
Next i
 
End Sub

.

 

[Korhan Ayhan]

Selamlar,

Bende ilk dosyanıza göre aşağıdaki kodu hazırlamıştım. Alternatif olarak denermisiniz.

Option Explicit
 
Sub HESAPLA()
    Dim X As Long, Y As Byte, İlk_Sütun As Byte, Son_Sütun As Byte
    
    Range("BD5:BF" & Rows.Count).ClearContents
    
    If WorksheetFunction.Sum(Range("BD3:BF3")) > 50 Then
        MsgBox "Girdiğiniz değerlerin toplamı 50 değerinden büyüktür !" & Chr(10) & _
        "Lütfen kontrol ediniz !", vbCritical
        Exit Sub
    End If
    
    For X = 5 To Cells(Rows.Count, 1).End(3).Row
        İlk_Sütun = 5
        If Cells(X, 3) <> "" Then
            For Y = 56 To 58
                Son_Sütun = İlk_Sütun + Cells(3, Y) - 1
                Cells(X, Y) = WorksheetFunction.CountIf(Range(Cells(X, İlk_Sütun), Cells(X, Son_Sütun)), "D")
                If Cells(X, Y) = 0 Then Cells(X, Y) = ""
                İlk_Sütun = Son_Sütun + 1
            Next
        End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[gertt]

Ömer bey ve Korhan bey,ilgi ve alakanızdan dolayı teşekkürlerimi sunarım.Her iki kod da harika çalışıyor.Sorun halledildi.Ellerinize sağlık.Çalışmalarınızda Allah kolaylık versin.Hayırlı akşamlar.

 

[Ömer]

Alternatif olarak fonksiyon'lu çözümüde paylaşayım.

BD5:

=EĞER(YADA(TOPLA($A$1:$C$1)>50;A5="";$A$1="");"";
   EĞERSAY(KAYDIR($E5;;;;$A$1);"d"))

BE5:

=EĞER(YADA(TOPLA($A$1:$C$1)>50;A5="";$A$1="");"";
   EĞERSAY(KAYDIR($E5;;$A$1;;$B$1);"d"))

BF5:

=EĞER(YADA(TOPLA($A$1:$C$1)>50;A5="";$A$1="");"";
   EĞERSAY(KAYDIR($E5;;$A$1+$B$1;;$C$1);"d"))

hücrelerine yazarak alt satırlara kopyalayınız.

.

 

[gertt]

Ömer bey merhaba.
Zahmet olur düşüncesiyle formülleri de yazın diyemedim.Kalp kalbe karşıymış.Ellerinize sağlık.Tekrar teşekkürler.