koşullu toplama ile ilgili

[frestylee]

ekli dosyada anlattıgım gibi etopla ile aldıgım değerin vba karşılıgı yardım ederseniz bewni büyük bi dertten kurtarırsınız...tşkler şimdiden

 

[Korhan Ayhan]

Selamlar,

Aşağıdai kodu denermisiniz.

Sub ETOPLA_UYGULA()
    Set S1 = Sheets("ÇELİKLER HAKEDİŞ MAHSUP")
    Set S2 = Sheets("DKB Günlük Kömür TAKİP 2008")
    S1.Select
    For X = 12 To [A65536].End(3).Row
    Kriter1 = Cells(X, 1) & Cells(X, 2) & "BİR"
    Kriter2 = Cells(X, 1) & Cells(X, 2) & "İKİ"
    Cells(X, 12) = WorksheetFunction.SumIf(S2.[N:N], Kriter1, S2.[I:I])
    Cells(X, 16) = WorksheetFunction.SumIf(S2.[N:N], Kriter2, S2.[I:I])
    Next
    Set S1 = Nothing
    Set S2 = Nothing
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[frestylee]

korhan ayhan bey vakit ayırıp ilgilendiğiniz için çok tşk ederim ben bu kodu

Sub ETOPLA_UYGULA()
Set S1 = Sheets("ÇELİKLER HAKEDİŞ MAHSUP")
Set S2 = Sheets("DKB Günlük Kömür TAKİP 2008")
S1.Select
For X = 12 To [A65536].End(3).Row
Kriter1 = Cells(X, 1) & Cells(X, 2) & "BİR"
Kriter2 = Cells(X, 1) & Cells(X, 2) & "İKİ"
Kriter3 = Cells(X, 1) & Cells(X, 2) & "ÜÇ"
Kriter4 = Cells(X, 1) & Cells(X, 2) & "DÖRT"
Kriter5 = Cells(X, 1) & Cells(X, 2) & "BEŞ"
Kriter6 = Cells(X, 1) & Cells(X, 2) & "ALTI"
Kriter7 = Cells(X, 1) & Cells(X, 2) & "YEDİ"
Kriter8 = Cells(X, 1) & Cells(X, 2) & "SEKİZ"
Kriter9 = Cells(X, 1) & Cells(X, 2) & "DOKUZ"
Kriter10 = Cells(X, 1) & Cells(X, 2) & "ON"

Cells(X, 12) = WorksheetFunction.SumIf(S2.[N:N], Kriter1, S2.[I:I])
Cells(X, 16) = WorksheetFunction.SumIf(S2.[N:N], Kriter2, S2.[I:I])
Cells(X, 20) = WorksheetFunction.SumIf(S2.[N:N], Kriter3, S2.[I:I])
Cells(X, 24) = WorksheetFunction.SumIf(S2.[N:N], Kriter4, S2.[I:I])
Cells(X, 28) = WorksheetFunction.SumIf(S2.[N:N], Kriter5, S2.[I:I])
Cells(X, 32) = WorksheetFunction.SumIf(S2.[N:N], Kriter6, S2.[I:I])
Cells(X, 36) = WorksheetFunction.SumIf(S2.[N:N], Kriter7, S2.[I:I])
Cells(X, 40) = WorksheetFunction.SumIf(S2.[N:N], Kriter8, S2.[I:I])
Cells(X, 44) = WorksheetFunction.SumIf(S2.[N:N], Kriter9, S2.[I:I])
Cells(X, 48) = WorksheetFunction.SumIf(S2.[N:N], Kriter10, S2.[I:I])

Next
Set S1 = Nothing
Set S2 = Nothing
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

bu şekilde uzatttım bayagı bi hesaplamada zorluk çekiyor ama doğru sonucu alıyorum tşk ediyorum tekrar