Koşullu Toplamın Vbadaki kullanımı hakkında

[hsayar]

Selamlar;
L71 hücresinde aşağıdaki gibi bir formülümüz var,

=TOPLA(EĞER(B71=A8:A90; EĞER(H71=H8:H90; EĞER("İçi"=N8:N90; J8:J90;0))))

ve bu değer herzaman aynı yerinde olmadığı için dögüden buraya geliyor. sadece değerin gözükmesini istediğim için kopyala, özel yapıştır ile bu kısmı geçiyorum. (kırmızı satırlar)

    For syc_i = 1 To BY_Sayisi
      syc_ii = syc_i + mygd_bassat
      .Cells(syc_ii, "B").Value = srgYil
      .Cells(syc_ii, "C").Value = .Cells(syc_ii, "B").Value & " Mali Yılı İçin"
      .Range(.Cells(syc_ii, "C"), .Cells(syc_ii, "G")).MergeCells = True
      .Cells(syc_ii, "H").Value = FncHsr_Benzersiz(wsTBL.Range("A2:A" & TablomYillarSonSat), syc_i)
      .Cells(syc_ii, "I").Value = "Bütçesinden"
      .Range(.Cells(syc_ii, "I"), .Cells(syc_ii, "K")).MergeCells = True
      With .Cells(syc_ii, "L")
[COLOR=Red]        .FormulaArray = "=SUM(IF(B" & syc_ii & "=A8:A" & SonSat_Rpr & _
                           ", IF(H" & syc_ii & "=H8:H" & SonSat_Rpr & _
                           ", IF(""İçi""=N8:N" & SonSat_Rpr & _
                           ", J8:J" & SonSat_Rpr & ",0))))"
        .NumberFormat = "#,##0.00"
        '.Copy
        '.PasteSpecial Paste:=xlPasteValues: Application.CutCopyMode = False[/COLOR]
      End With
      mygd_sonsat = mygd_bassat + BY_Sayisi + 1
      yuzdeAddr = .Cells(mygd_sonsat, "L").Address(False, False)
      bolAddr = .Cells(syc_ii, "L").Address(False, False)
      With .Cells(syc_ii, "M")
        .Formula = "=100*" & bolAddr & "/" & yuzdeAddr
        .NumberFormat = "#,##0.00"
      End With
    Next syc_i

ancak aşağıdaki şekilde bir yöntem gördüm bunu 3 koşulda gerçekleşiyorsa toplamayı yap komutu şeklinde nasıl düzenlerim. BU şekilde düzenlendiği takdirde kodun daha hızlı çalışacağını, hızlı çalışmasa bile daha işlevsel olacağını düşünüyorum.

'WorksheetFunction.SumIf(s1.[b:b], s1.Cells(a, "b"), s1.[d:d])

Saygılarımla.

 

[hsayar]

ben ayrı bir prosodürde örneklemeye çalıştım yeşil satırlar tek tek gayet güzel sonuç üretiyor, kırmızı satırda ise hata veriyır ve benim istediğimde 3 koşul gerçekleşince sonuç almak.

Sub SumifTesthsr()
Dim wsBlnc As Worksheet
Dim AppWFnc As WorksheetFunction
Set AppWFnc = Application.WorksheetFunction

Dim rngKos1 As Range, rngKrs1 As Range
Dim rngKos2 As Range, rngKrs2 As Range
Dim rngKos3 As Range, strKrs3 As String

Dim rngTplm As Range

Dim strKrs1 As String
Set wsBlnc = Sheets("Yil_Biloncosu")
Dim dubToplam As Double
With wsBlnc
Set rngKos1 = .Range("A8:A68")
Set rngKrs1 = .Range("b71")
Set rngKos2 = .Range("h8:h68")
Set rngKrs2 = .Range("h71")
Set rngKos3 = .Range("n8:n68")
    strKrs3 = "içi"
Set rngTplm = .Range("j8:j68")

[COLOR=DarkGreen]'dubToplam = AppWFnc.SumIf(rngKos1, "=" & rngKrs1, rngTplm)
'dubToplam = AppWFnc.SumIf(rngKos2, "=" & rngKrs2, rngTplm)
'dubToplam = AppWFnc.SumIf(rngKos3, "=" & "içi", rngTplm)[/COLOR]

[COLOR=Red]dubToplam = AppWFnc.SumIf(rngKos1, "=" & rngKrs1 And rngKos2, "=" & rngKrs2 And rngKos3, "=" & strKrs3, rngTplm)[/COLOR]

MsgBox dubToplam
End With

End Sub

 

[Ferhat Pazarçevirdi]

ETOPLA/SUMIF fonksiyonunu kullanıyorsanız; "Üç koşul gerçekleşince" diye birşeyden sözedemezsiniz ... Burada bir mantık hatası var.

SUMIF yerine SUMPRODUCT fonksiyonunu kullanmayı deneyin. Orada istediğiniz kadar koşul argumanı tanımlayabilirsiniz.

 

[hsayar]

Hocam cevabınız için teşekkür ederim.
ben hücreden yada FormulaArray yöntemi ile girdiğimiz şekilde bunuda elde ederiz sanmıştım.
Peki Hücreye Değer yazacak şekilde topla.çarpım örneği nasıl olmalıdır?

 

[Ferhat Pazarçevirdi]

SUMIF'i kodlarınızda nasıl kullanıyorsanız, SUMPRODUCT'ı da o şekilde kullanabilirsiniz.

dubToplam = AppWFnc.SumProduct ([COLOR=red]koşul1[/COLOR], [COLOR=green]koşul2[/COLOR], [COLOR=blue]koşul3[/COLOR])

gibi olabilir ...

 

[hsayar]

hocam örnek kod baktım ancak http://www.excel.web.tr/showthread.php?t=4941
burada çözümsüzlükten söz ediliyor.. Yardımcı olursanız sevinirim.

Aşağıdaki şekilde denedim
Type Miscimatt 13 hatası aldım.

 dubToplam = AppWFnc.SumProduct((rngKos1 = rngKrs1), (rngKos2 = rngKrs2), (rngKos3 = strKrs3), rngTplm)
[FONT=Courier New]

Koşullu Toplam Formulüm
=TOPLA(EĞER(B71=A8:A90; EĞER(H71=H8:H90; EĞER("İçi"=N8:N90; J8:J90;0))))

ün karşılığ Topla.Çarpım Formülüm
=TOPLA.ÇARPIM((B71=$A$8:$A$90)*(H71=$H$8:$H$90)*("İÇİ"=$N$8:$N$90)*($J$8:$J$90))

bunlardan herhangi birinin vb karşılığı nasıl olmalıdır?
[/FONT]

 

[hsayar]

bu şekilde denedim olmadı, olmuyor.
dubToplam = Evaluate("=SUMPRODUCT((rngKrs1=rngKos1)*(rngKrs2=rngKos2)*(strKrs3=rngKos3)")

 

[Ferhat Pazarçevirdi]

Aşağıdaki gibi bir kodlama geliştirebilirsiniz. Koşullarla oluşacak dizileri, özel ad tanımları ile geçici olarak atayabilirsiniz.

Anladığım kadarıyla, SumProduct kodlamasında bazı sıkıntılar var. Özellikle, SumProduct içinde kriter belirtmek oldukça zor. Ama kriter belirtmeden, istediğiz kadar dizinin çarpımına izin veriyor.

Bu durumda, dizileri, kodlarla önceden oluşturup, SUmProduct'a "Al ye kardeşim" demekten başka bir şey kalmıyor.

Sub Alternatif_SumProduct_Kullanimi()
        
[COLOR=darkgreen]    'Geçici Özel ad tanımları kitaba ekleniyor
[/COLOR]    With Names
        
[COLOR=darkgreen]        'A1:A44 aralığında 5'den küçük değerlerin toplandığı dizi[/COLOR]
        .Add "Dgr1", "=(" & Range("A1:A44").Address & "<5)*1"
        
[COLOR=darkgreen]        'B1:B44 aralığında 50'den küçük değerlerin toplandığı dizi[/COLOR]
        .Add "Dgr2", "=(" & Range("B1:B44").Address & "<50)*1"
    
    End With
    
[COLOR=darkgreen]    'Sumproduct fonsksiyonu değerlendiriliyor
         'Bu fonksiyon A sütununda 5'ten küçük,
         'B sütununda ise 50'den küçük değerlerin sayısı hesaplıyor[/COLOR]
    
    MsgBox Application.Evaluate("SUMPRODUCT(Dgr1,dgr2)")
    
[COLOR=darkgreen]    'Eklenen adlar siliniyor[/COLOR]
    Names("Dgr1").Delete: Names("Dgr2").Delete
End Sub

 

[hsayar]

Teşekkür ederim hocam, umarım benim prosodürümde de işe yarar benimkilerde üç değer doğru ise 4.değerin toplamını alacak...
çalışmak lazım.
emekleriniz için tekrar teşekkür ederim.

 

[hsayar]

hocam
.Add "Dgr1", "=(" & Range("A1:A44").Address & "<5)*1"
satırında rte-1004 hatası alıyorum;

girdiğiniz ad geçersiz. buna aşağıdakiler sebeb olabilir;

-Ad bir harf veya alt çizgi ile başlamıyor
- " boşluk veya diğer geçersiz karakterler içeriyor.
- " excel yerleşik adı veya diğer nesne adı ile çakışıyor.

 

[Ferhat Pazarçevirdi]

Bu hatayı almamış olmanız gerekiyor ... Kodları adapte ederken mi bir şeyi gözden kaçırdınız acaba? ... Örnek bir dosya gönderiyorum ... Test ediniz.

Size verdiğim örnek kodlar birebir kullanılmışltır

 

[hsayar]

hocam adapte etmedim bile sadece araya bir adet stop satırı koydum ki açlışırken test edeyim. örnek için teşekkür ederim.

Sub Alternatif_SumProduct_Kullanimi()
Dim ClsSf As Worksheet:         Set ClsSf = Worksheets("sayfa1")
    'Geçici Özel ad tanımları kitaba ekleniyor
    With Names
        
        'A1:A44 aralığında 5'den küçük değerlerin toplandığı dizi
        '.Add "Dgr1", "=(" & "a1:a44" & "<5)*1"
        .Add "Dgr1", "=(" & Range("A1:A44").Address & "<5)*1"
        'B1:B44 aralığında 50'den küçük değerlerin toplandığı dizi
        .Add "Dgr2", "=(" & Range("B1:B44").Address & "<50)*1"
    
    End With
    Stop
    'Sumproduct fonsksiyonu değerlendiriliyor
         'Bu fonksiyon A sütununda 5'ten küçük,
         'B sütununda ise 50'den küçük değerlerin sayısı hesaplıyor
    
    MsgBox Application.Evaluate("SUMPRODUCT(Dgr1,dgr2)")
    
    'Eklenen adlar siliniyor
    Names("Dgr1").Delete: Names("Dgr2").Delete
End Sub

 

[hsayar]

Ben işin kolyaını kopyala/özel yapıştırı döngüden çıktıktan sonra yapmakta buldum. WorksheetFunction.sumif şeklinde kullanım bulununca bilgi verirseniz sevinirim.

benim çözümüm şimdilik;

    '========================================================================================================================================||
    ' X yılı çeltik üretim maliyetine etki eden faktörlerin yıllık dağılımı
    'Başlıkları
    SonSat_Myd = .Cells(65536, "B").End(3).Row
    mygd_bassat = SonSat_Myd + 2
    .Cells(mygd_bassat, "B").Value = srgYil & " Yılı Çeltik Üretim Maliyetine Etki Eden Faktörlerin Yıllık Dağılımı"
    .Range(.Cells(mygd_bassat, "B"), .Cells(mygd_bassat, "L")).MergeCells = True
    .Cells(mygd_bassat, "m").Value = " %si"
    'yıllara göre dağılımı
    syc_i = 0: syc_ii = 0
    For syc_i = 1 To BY_Sayisi
      syc_ii = syc_i + mygd_bassat
      .Cells(syc_ii, "B").Value = srgYil
      .Cells(syc_ii, "C").Value = .Cells(syc_ii, "B").Value & " Mali Yılı İçin"
      .Range(.Cells(syc_ii, "C"), .Cells(syc_ii, "G")).MergeCells = True
      .Cells(syc_ii, "H").Value = FncHsr_Benzersiz(wsTBL.Range("A2:A" & TablomYillarSonSat), syc_i)
      .Cells(syc_ii, "I").Value = "Bütçesinden"
      .Range(.Cells(syc_ii, "I"), .Cells(syc_ii, "K")).MergeCells = True
      With .Cells(syc_ii, "L")
       [B][COLOR=Blue] .FormulaArray = "=SUM(IF(B" & syc_ii & "=A8:A" & SonSat_Rpr & _
                           ", IF(H" & syc_ii & "=H8:H" & SonSat_Rpr & _
                           ", IF(""İçi""=N8:N" & SonSat_Rpr & _
                           ", J8:J" & SonSat_Rpr & ",0))))"[/COLOR][/B]
        .NumberFormat = "#,##0.00"
[B][COLOR=Red]'        .Copy
'        .PasteSpecial Paste:=xlPasteValues: Application.CutCopyMode = False[/COLOR][/B]
      End With
      mygd_sonsat = mygd_bassat + BY_Sayisi + 1
      yuzdeAddr = .Cells(mygd_sonsat, "L").Address(False, False)
      bolAddr = .Cells(syc_ii, "L").Address(False, False)
      With .Cells(syc_ii, "M")
        .Formula = "=100*" & bolAddr & "/" & yuzdeAddr
        .NumberFormat = "#,##0.00"
      End With
    Next syc_i
    'Toplamı
    .Cells(mygd_sonsat, "B") = srgYil & " Yılı Çeltik Üretim Maliyetine Etki Eden Faktörlerin Toplamı"
    .Range(.Cells(mygd_sonsat, "B"), .Cells(syc_ii + 1, "K")).MergeCells = True
    .Cells(mygd_sonsat, "L") = "=SUM(L" & (mygd_bassat + 1) & ":L" & syc_ii & ")"
    .Cells(mygd_sonsat, "M") = "=SUM(M" & (mygd_bassat + 1) & ":M" & syc_ii & ")"
[B][COLOR=DarkGreen]    Set rngBul = .Range(Cells(mygd_bassat, "b"), Cells(mygd_sonsat, "M"))
    With rngBul
      .Copy
      .PasteSpecial Paste:=xlPasteValues: Application.CutCopyMode = False
    End With[/COLOR][/B]
    Call hsr.KenarlikCiz_DisCift_Ic_Ince(rngBul)
    Set rngBul = Nothing

 

[hsayar]

Ben işin kolayını kopyala/özel yapıştırı döngüden çıktıktan sonra yapmakta buldum. WorksheetFunction.sumif şeklinde kullanım bulununca bilgi verirseniz sevinirim.

benim çözümüm şimdilik;

    '========================================================================================================================================||
    ' X yılı çeltik üretim maliyetine etki eden faktörlerin yıllık dağılımı
    'Başlıkları
    SonSat_Myd = .Cells(65536, "B").End(3).Row
    mygd_bassat = SonSat_Myd + 2
    .Cells(mygd_bassat, "B").Value = srgYil & " Yılı Çeltik Üretim Maliyetine Etki Eden Faktörlerin Yıllık Dağılımı"
    .Range(.Cells(mygd_bassat, "B"), .Cells(mygd_bassat, "L")).MergeCells = True
    .Cells(mygd_bassat, "m").Value = " %si"
    'yıllara göre dağılımı
    syc_i = 0: syc_ii = 0
    For syc_i = 1 To BY_Sayisi
      syc_ii = syc_i + mygd_bassat
      .Cells(syc_ii, "B").Value = srgYil
      .Cells(syc_ii, "C").Value = .Cells(syc_ii, "B").Value & " Mali Yılı İçin"
      .Range(.Cells(syc_ii, "C"), .Cells(syc_ii, "G")).MergeCells = True
      .Cells(syc_ii, "H").Value = FncHsr_Benzersiz(wsTBL.Range("A2:A" & TablomYillarSonSat), syc_i)
      .Cells(syc_ii, "I").Value = "Bütçesinden"
      .Range(.Cells(syc_ii, "I"), .Cells(syc_ii, "K")).MergeCells = True
      With .Cells(syc_ii, "L")
       [B][COLOR=Blue] .FormulaArray = "=SUM(IF(B" & syc_ii & "=A8:A" & SonSat_Rpr & _
                           ", IF(H" & syc_ii & "=H8:H" & SonSat_Rpr & _
                           ", IF(""İçi""=N8:N" & SonSat_Rpr & _
                           ", J8:J" & SonSat_Rpr & ",0))))"[/COLOR][/B]
        .NumberFormat = "#,##0.00"
[B][COLOR=Red]'        .Copy
'        .PasteSpecial Paste:=xlPasteValues: Application.CutCopyMode = False[/COLOR][/B]
      End With
      mygd_sonsat = mygd_bassat + BY_Sayisi + 1
      yuzdeAddr = .Cells(mygd_sonsat, "L").Address(False, False)
      bolAddr = .Cells(syc_ii, "L").Address(False, False)
      With .Cells(syc_ii, "M")
        .Formula = "=100*" & bolAddr & "/" & yuzdeAddr
        .NumberFormat = "#,##0.00"
      End With
    Next syc_i
    'Toplamı
    .Cells(mygd_sonsat, "B") = srgYil & " Yılı Çeltik Üretim Maliyetine Etki Eden Faktörlerin Toplamı"
    .Range(.Cells(mygd_sonsat, "B"), .Cells(syc_ii + 1, "K")).MergeCells = True
    .Cells(mygd_sonsat, "L") = "=SUM(L" & (mygd_bassat + 1) & ":L" & syc_ii & ")"
    .Cells(mygd_sonsat, "M") = "=SUM(M" & (mygd_bassat + 1) & ":M" & syc_ii & ")"
[B][COLOR=DarkGreen]    Set rngBul = .Range(Cells(mygd_bassat, "b"), Cells(mygd_sonsat, "M"))
    With rngBul
      .Copy
      .PasteSpecial Paste:=xlPasteValues: Application.CutCopyMode = False
    End With[/COLOR][/B]
    Call hsr.KenarlikCiz_DisCift_Ic_Ince(rngBul)
    Set rngBul = Nothing