Soru Sumİf formülünde kaydırma

[dengeceteris]

Merhaba Arkadaşlar;

Yazdığım formülde bir problemle karşılaşıyorum yada yazmak istediğimi ifade edemiyorum. (Formül S2 sayfasında) Aşağıda S2 sayfama, S1 sayfasında ki verileri çekiyorum. S2 sayfasında aralığı (s1.Range("AB:AB") yada (s1.Range("AC:AC") gibi yazarsam problem olmuyor. Ama "AB:AD" gibi birden fazla aralık sütun yapınca K veya J sütunu değilde 1 kaç yan sütuna gidip o sütundan sonuçları getiriyor. Herbir aralık için ayrı ayrı yazınca problem olmuyor ama bu seferde çok sayfam olduğu için her formülü 3 defa yazıyorum. Bunu yapmanın yolu nedir ?
Herkese kolay gelsin..

For x = 3 To son
For y = 1 To 25
If s2.Cells(x, 1) = "" Then
s2.Cells(x, 29) = ""
s2.Cells(x, 30) = ""
Else
s2.Cells(x, 29) = s2.Cells(x, 29) + wf.SumIf(s1.Range("AB:AD"), s2.Cells(x, y), s1.Range("K:K"))
s2.Cells(x, 30) = s2.Cells(x, 30) + wf.SumIf(s1.Range("AB:AD"), s2.Cells(x, y), s1.Range("J:J"))
End If
Next
Next

 

[dengeceteris]

Galiba çoketopla ile yazmam gerekiyor ama onu da uyarlayamadım.

 

[Ömer]

Merhaba,

Yapmak istediğinizi küçük bir örnek dosya ekleyerek açıklar mısınız.

 

[dengeceteris]

Ömer bey merhabalar;
Ekte yapmaya çalıştığım örnek dosyayı yükledim. DATA sayfasında verilerim var. Onları SONUÇ sayfasına çekiyorum. Yalnız şunu sormak istiyorum. Benim bu şekilde bir dosya içinde çok fazla veri aktarımı yaptığım sayfam var (Yaklaşık 30 sayfa). Sizde göreceksiniz tek bir sayfada bile yavaş çalışıyor. Dosyanın yapısı mıdır. Yada daha pratik yazılımlar mı yapmak gerekiyor anlamadım.

 

[dengeceteris]

Ömer bey bakma fırsatınız oldu mu ?

 

[Ömer]

Konu içeriğini çok anlamadım fakat yine aynı mantıkla SumIf ile iki döngüye gerek kalmadan ve aralıkları dinamik yaparak çok daha hızlı sonuçlar alabilirsiniz.

Sub hesapla()

    Dim i As Long, sons As Long, sond As Long, z As Date
    Dim Sd As Worksheet, Ss As Worksheet, Wf As WorksheetFunction
    Dim a1 As String, a2 As String, a3 As String, a4 As String, b1 As String

    z = Timer

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    Set Sd = Sheets("DATA")
    Set Ss = Sheets("SONUÇ")
    Set Wf = WorksheetFunction
    
    Ss.Select
    sons = Cells(Rows.Count, 1).End(xlUp).Row
    sond = Sd.Cells(Rows.Count, 1).End(xlUp).Row
    Range("L4:M" & Rows.Count).ClearContents
    
    a1 = Sd.Range("F4:F" & sond).Address(external:=True)
    a2 = Sd.Range("G4:G" & sond).Address(external:=True)
    a3 = Sd.Range("D4:D" & sond).Address(external:=True)
    a4 = Sd.Range("E4:E" & sond).Address(external:=True)
    
    For i = 4 To sons
        If Wf.CountA(Cells(i, "A").Resize(1, 11)) > 0 Then
            b1 = Cells(i, "A").Resize(1, 11).Address
            Cells(i, 12) = Evaluate("=SUM(SUMIF(" & a1 & "," & b1 & "," & a3 & "))")
            Cells(i, 13) = Evaluate("=SUM(SUMIF(" & a2 & "," & b1 & "," & a4 & "))")
        End If
    Next
    
    Range("L4:M" & Rows.Count).NumberFormat = "#,##0.00"
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "Süre: " & Format(Timer - z, "0.00"), vbInformation
      
End Sub

 

[dengeceteris]

Ömer bey selamlar:
Yapmaya çalıştığım şu: DATA sayfasında "D" ve "E" sütunlarında bulunan rakamları SONUÇ sayfasında ki "L" ve "M" sütunlarına klasik bir etopla şeklinde getirmek. Burada toplama ölçütüm SONUÇ sayfasında ki 1 ile 11. sütunlar arası. SONUÇ sayfasında bulunan 1, 13, 15 gibi karakter uzunluğu 1 veya 2 olanlar ise aslında SONUÇ sayfasında bulunan tablomun ara veya üst toplamlarını ifade ediyor. Mesela SONUÇ sayfamda A8 hücresinde 13 rakamı bulunuyor. Bu rakam aslında A9:K12 arasını A8 satırına toplayabilmek için yazılmış bir rakam yani bir bakıma ara toplamları alarak gitmeye çalışıyorum. Mutlaka bunların çok daha pratik yolları vardır ama ben bunları bilmiyorum. Yeni bir tablo yükledim sadece eski yüklediğim dosyada DATA sayfasında ki "H" sütununu sildim (Zaten aynı kodlar A sütununda var) Aşağıya yazdığım formülü zannedersem amacımı daha iyi belirtir. Sizin kodları uyguladığım zaman ise 3 karakter uzunluğunda olan verilerin sonuçlarını getirmedi.

=ÇOKETOPLA(DATA!D:d;DATA!F:F;A4:K4;DATA!G:G;A4:K4;DATA!A:A;A4:K4)
=ÇOKETOPLA(DATA!E:E;DATA!F:F;A4:K4;DATA!G:G;A4:K4;DATA!A:A;A4:K4)

 

[dengeceteris]

Ömer bey tekrar selamlar:

Uğraşmayın diye yazıyorum.. en son gönderdiğiniz kod üzerinde epeyce çalıştım çok çok iyi sonuçlar aldım. tşk ederim.

 

[Ömer]

İki gündür yoğun olduğumdan ilgilenemiştim. İşinize yaradığına sevindim.
Selamlar.