Makro Toplam aldırmak.

[ramazankaya89]

herkese merhaba iyi bayramlar asagıdakı krıterlere gore bır makro koduna ıhtıyacım var satır sayısı cok oldugu ıcın formul kasıyor
makro olarak yardımcı olursanız cok sevınırım. ornek dosyam mevcut degıl bir projede buna benzer bı ısleme ıhtıyacım olacak olup bu degerlere gore oraya uygulayacagım.


1.sayfanın adı ("bilgi")
2.sayfanın adı ("hesaplama")
Döviz toplam alanı : bilgi sayfası / Sütun N / Satır 2 den başlayıp en son satıra kadar
Fatura numarası alanı : bilgi sayfası / Sütun E / Satır 2 den başlayıp en son satıra kadar
Fatura numarası alanı (2) : hesaplama sayfası / Sütun A / Satır 2 den başlayıp en son satıra kadar
Toplama kriteri alanı : bilgi sayfası / Sütun AD / Satır 2 den başlayıp en son satıra kadar
Toplayacağı kriter : "EAA-301"

Yapmak istediğim ;
Application.WorksheetFunction.SumIfs kodunu kullanarak hesaplama sayfası O sütunu 2.satırdan baslayıp en son satıra kadar olan _
kısımda fatura numarası alanı 2 ye göre fatura numarası alanındaki degerleri toplayacagı kritere göre toplamlarını yazdırmak.

not : Fatura numarası alanı ve Fatura numarası alanı (2) alanındaki degerler birebir aynı degerlerdir bu degerlere gore coketopla yaptırılacaktır.

 

[Korhan Ayhan]

Kendi dosyanıza uyarlarsınız.

Option Explicit

Sub VBA_Sumifs()
    Dim S1 As Worksheet, S2 As Worksheet

    Set S1 = Sheets("hesaplama")
    Set S2 = Sheets("bilgi")

    S1.Range("O2:O" & S1.Rows.Count).ClearContents

    With S1.Range("O2:O" & S1.Cells(S1.Rows.Count, 1).End(3).Row)
        .Formula = "=SUMIFS('" & S2.Name & "'!N:N,'" & S2.Name & "'!E:E,A2,'" & S2.Name & "'!AD:AD,""EAA-301"")"
        .Value = .Value
    End With

    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ramazankaya89]

arkadaslar günaydın application worksheet function sumıfs olarak yazacak ve yardımcı olabilecek birisi varmı bu formatta sorunu cozmem lazım lütfen yardım edin

 

[Korhan Ayhan]

#2 nolu mesajdaki kodu deneyiniz.

 

[ramazankaya89]

O benim dosyaya uymuyor hocam ic içe çok değerim var hepsini bozmam gerekiyor
application worksheet function formatında yardım edebilirmisiniz rica etsem

 

[Korhan Ayhan]

Dediğiniz yöntemde döngü kullanmak zorunda kalacaksınız. Bu da yavaş sonuç verecektir.

 

[ramazankaya89]

olsun hocam yavas olsun cunku cok yerde degısıklık yapmam gerekıyor emegınız ıcın tesekkur ederım sımdıden

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub VBA_Sumifs()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Sum_Range As Range
    Dim Criteria_Range1 As Range
    Dim Criteria_Range2 As Range

    Set S1 = Sheets("hesaplama")
    Set S2 = Sheets("bilgi")
    Set Sum_Range = S2.Range("N:N")
    Set Criteria_Range1 = S2.Range("E:E")
    Set Criteria_Range2 = S2.Range("AD:AD")

    S1.Range("O2:O" & S1.Rows.Count).ClearContents

    For X = 2 To S1.Cells(S1.Rows.Count, 1).End(3).Row
        S1.Cells(X, "O") = Application.WorksheetFunction.SumIfs(Sum_Range, Criteria_Range1, S1.Cells(X, "A"), Criteria_Range2, "EAA-301")
    Next

    Set Sum_Range = Nothing
    Set Criteria_Range1 = Nothing
    Set Criteria_Range2 = Nothing
    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ramazankaya89]

elinize saglık deneyecegım cok tesekkurler

 

[ramazankaya89]

Hocam ALLAH razı olsun büyüksün süper oldu cok ısıme yaradı bu kod ıle ılave olarak toplam degerleri 0 ise hic bisey getirmemesini hangi kısma ilave edebilirim.

 

[Korhan Ayhan]

NEXT satırının üstüne alttaki satırı ekleyebilirsiniz.

If S1.Cells(X, "O") = 0 Then S1.Cells(X, "O") = ""

 

[ramazankaya89]

tamamdır

 

[ramazankaya89]

korhan hocam toplamların sonuclarını aynı döngü icinde farklı satırlara böldürme ve carptırma yapmak istedigim bir islem icin asagıdakı metotda kod calısmıyor
hepsine dim set ve nothing alanlarını eslememe ragmen bu degerler ile böldürme carptırma da yaptırdım olmadı nereyı atlıyorum acaba


Sayfa1.Cells(X, "B") = Sayfa1.Cells(X, "M") / Sayfa1.Cells(X, "L") * Sayfa1.Cells(X, "O")

 

[Korhan Ayhan]

Belki eklediğiniz satırlardaki hesaplama sıralaması yanlış olabilir..

 

[ramazankaya89]

sıralamayı degıstırdım fakat yıne olmadı kalın olarak ısaretledigim alanı yapmak ıstıyorum ama bolup carpma ıslemı yapmıyor




For X = 2 To Sayfa1.Cells(Sayfa1.Rows.Count, 1).End(3).Row

Sayfa1.Cells(X, "O") = Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Binek_1) _
+ Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Binek_2)

Sayfa1.Cells(X, "P") = Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Brake_Disc_1) _
+ Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Brake_Disc_2)

Sayfa1.Cells(X, "Q") = Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Brake_Pad_1) _
+ Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Brake_Pad_2)

Sayfa1.Cells(X, "R") = Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Brake_Drum_1) _
+ Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Brake_Drum_2)

Sayfa1.Cells(X, "S") = Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Brake_Spray_1) _
+ Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Result_Update, Brake_Spray_2)

Sayfa1.Cells(X, "N") = Application.WorksheetFunction.SumIfs(Currency_Amount_Tr, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Department_Code, Cost_Code)

Sayfa1.Cells(X, "M") = Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Department_Code, Cost_Code)

Sayfa1.Cells(X, "L") = Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A")) _
- Application.WorksheetFunction.SumIfs(Currency_Amount, Ssp_Tr_Invoice_No, Sayfa1.Cells(X, "A"), Department_Code, Cost_Code)




Masraf_Döviz_Toplamı = Sayfa1.Cells(X, "M")
Masraf_Hariç_Fatura_Döviz_Toplamı = Sayfa1.Cells(X, "L")
Binek_Döviz = Sayfa1.Cells(X, "O")




Sayfa1.Cells(X, "B") = Masraf_Döviz_Toplamı / Masraf_Hariç_Fatura_Döviz_Toplamı * Binek_Döviz



If Sayfa1.Cells(X, "O") = 0 Then Sayfa1.Cells(X, "O") = ""
If Sayfa1.Cells(X, "P") = 0 Then Sayfa1.Cells(X, "P") = ""
If Sayfa1.Cells(X, "Q") = 0 Then Sayfa1.Cells(X, "Q") = ""
If Sayfa1.Cells(X, "R") = 0 Then Sayfa1.Cells(X, "R") = ""
If Sayfa1.Cells(X, "S") = 0 Then Sayfa1.Cells(X, "S") = ""
If Sayfa1.Cells(X, "N") = 0 Then Sayfa1.Cells(X, "N") = ""
If Sayfa1.Cells(X, "M") = 0 Then Sayfa1.Cells(X, "M") = ""
If Sayfa1.Cells(X, "L") = 0 Then Sayfa1.Cells(X, "L") = ""




Next


Set Sayfa1 = Nothing
Set Sayfa2 = Nothing
Set Currency_Amount = Nothing
Set Currency_Amount_Tr = Nothing
Set Department_Code = Nothing
Set Ssp_Tr_Invoice_No = Nothing
Set Result_Update = Nothing


MsgBox "tamamlandı"

End Sub

 

[Korhan Ayhan]

Kodu F8 ile adım adım çalıştırıp değişkenlerin aldığı değerleri kontrol edebilirsiniz.