• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Topla.çarpım makro ile 2 tarih arası aralıklı sütun

K

kelkitli

Katılım
23 Şubat 2007
Mesajlar
1,212
Excel Vers. ve Dili
Excel2003
Selamlar,
Ekteki tabloda formülle yapılmış topla.çarpımı makro ile son dolu satıra göre yapabilirmiyiz. Bu şekilde dosyayı kasıyor.
Saygılar.
 

Ekli dosyalar

kelkitli' Alıntı:
Selamlar,
Ekteki tabloda formülle yapılmış topla.çarpımı makro ile son dolu satıra göre yapabilirmiyiz. Bu şekilde dosyayı kasıyor.
Saygılar.
Genişletmek için tıkla ...

Merhaba
Boş bir module kopyalayıp dener misiniz_?
Kod: 
Option Explicit
Sub tarih_arası_toplam_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, asi
Set bordo = Sheets("ÇALIŞMA")
Set mavi = Sheets("FİRMA")
trabzonspor = MsgBox(CDate(mavi.Range("C1")) & " İle" & vbLf _
& CDate(mavi.Range("C2")) & " Arasında Toplamları Alıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
mavi.Range("B4:R28").ClearContents
For kaplan = 2 To 17
For ts = 4 To mavi.Cells(Rows.Count, "A").End(xlUp).Row
For asi = 2 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If bordo.Cells(asi, "B") >= mavi.Range("C1") And _
bordo.Cells(asi, "B") <= mavi.Range("C2") And _
bordo.Cells(asi, "E") = mavi.Cells(ts, "A") And _
bordo.Cells(asi, "C") = mavi.Cells(3, kaplan) Then
mavi.Cells(ts, kaplan) = mavi.Cells(ts, kaplan) + bordo.Cells(asi, "F")
End If
Next
mavi.Cells(ts, "R") = mavi.Range("B" & ts) + mavi.Range("D" & ts) + mavi. _
Range("F" & ts) + mavi.Range("H" & ts) + mavi.Range("J" & ts) + mavi. _
Range("L" & ts) + mavi.Range("N" & ts) + mavi.Range("P" & ts)
Next
mavi.Cells(28, kaplan) = WorksheetFunction.Sum(mavi.Range(mavi.Cells(4, kaplan).Address _
& ":" & mavi.Cells(27, kaplan).Address))
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & " Sürede" & vbLf _
& CDate(mavi.Range("C1")) & " İle" & vbLf _
& CDate(mavi.Range("C2")) & " Arasındaki Toplamarı Aktardım", , "Bitiş"
End Sub
 
İhsan Hocam,
Toplam tutarları da sağdaki C,E,G,I,K,M,O,Q sütunlarına almak istesem eziyeti çok olurmu.
Mümkünse bunu da ekleyelim vallahi çok güzel olacak
 
kelkitli' Alıntı:
İhsan Hocam,
Toplam tutarları da sağdaki C,E,G,I,K,M,O,Q sütunlarına almak istesem eziyeti çok olurmu.
Mümkünse bunu da ekleyelim vallahi çok güzel olacak
Genişletmek için tıkla ...

Bunu yapacaktım ama kafam karıştığı için ve istemediğiniz için yapmadım.
Hangi sütunu toplayacak mesela F sütunundaki karşılıkları toplattık bu sefer hangi sütunu toplayacak ve hepsinin toplamı alınacak mı_?
 
Hocam, toplam tutar J sütununda. Her aracın sol taraf sütuna sefer adetleri, sağ tarafa j sütunundaki toplam tutarlar yazılacak. Toplamlarda alınacak. (Şu an gelen bilgiler doğru ve yerindeler)Birde FİRMA ekleneceği için sayfa alt kısma doğru bilgi ilave edilecek. Alt Toplam ondan sonra. Hocam zahmetim için kusura bakmayın lütfen.
 
kelkitli' Alıntı:
Hocam, toplam tutar J sütununda. Her aracın sol taraf sütuna sefer adetleri, sağ tarafa j sütunundaki toplam tutarlar yazılacak. Toplamlarda alınacak. (Şu an gelen bilgiler doğru ve yerindeler)Birde FİRMA ekleneceği için sayfa alt kısma doğru bilgi ilave edilecek. Alt Toplam ondan sonra. Hocam zahmetim için kusura bakmayın lütfen.
Genişletmek için tıkla ...

Merhaba
Kodu bununla değiştirip dener misiniz_?
Kod: 
Option Explicit
Sub tarih_arası_toplam_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, asi
Set bordo = Sheets("ÇALIŞMA")
Set mavi = Sheets("FİRMA")
trabzonspor = MsgBox(CDate(mavi.Range("C1")) & " İle" & vbLf _
& CDate(mavi.Range("C2")) & " Arasında Toplamları Alıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
mavi.Range("B4:R28").ClearContents
For kaplan = 2 To 17
For ts = 4 To mavi.Cells(Rows.Count, "A").End(xlUp).Row
For asi = 2 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If bordo.Cells(asi, "B") >= mavi.Range("C1") And _
bordo.Cells(asi, "B") <= mavi.Range("C2") And _
bordo.Cells(asi, "E") = mavi.Cells(ts, "A") And _
bordo.Cells(asi, "C") = mavi.Cells(3, kaplan) Then
mavi.Cells(ts, kaplan) = mavi.Cells(ts, kaplan) + bordo.Cells(asi, "F")
mavi.Cells(ts, kaplan + 1) = mavi.Cells(ts, kaplan + 1) + bordo.Cells(asi, "J")
End If
Next
mavi.Cells(ts, "R") = mavi.Range("B" & ts) + mavi.Range("D" & ts) + mavi. _
Range("F" & ts) + mavi.Range("H" & ts) + mavi.Range("J" & ts) + mavi. _
Range("L" & ts) + mavi.Range("N" & ts) + mavi.Range("P" & ts)
mavi.Cells(ts, "S") = mavi.Range("C" & ts) + mavi.Range("E" & ts) + mavi. _
Range("G" & ts) + mavi.Range("I" & ts) + mavi.Range("K" & ts) + mavi. _
Range("M" & ts) + mavi.Range("O" & ts) + mavi.Range("Q" & ts)
'C,E,G,I,K,M,O,Q
Next
ts = mavi.Range("A" & Rows.Count).End(xlUp).Row
mavi.Cells(ts + 1, kaplan) = WorksheetFunction.Sum(mavi.Range(mavi.Cells(4, kaplan).Address _
& ":" & mavi.Cells(ts, kaplan).Address))
mavi.Cells(ts + 1, kaplan + 1) = WorksheetFunction.Sum(mavi.Range(mavi.Cells(4, kaplan + 1).Address _
& ":" & mavi.Cells(ts, kaplan + 1).Address))
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & " Sürede" & vbLf _
& CDate(mavi.Range("C1")) & " İle" & vbLf _
& CDate(mavi.Range("C2")) & " Arasındaki Toplamarı Aktardım", , "Bitiş"
End Sub
 
Hocam çok çok teşekkür ederim. Allah razı olsun. İşlem tamam.
 
Son düzenleme:
Topla.Çarpım fonksiyonunun makro haliyle yapılmış bir çözüm.
Kod: 
Sub SumProduct15()
    s = Sheets("ÇALIŞMA").[a65536].End(3).Row
    sRangeA = "Çalışma!b2:b" & s
    sRangeB = "Çalışma!b2:b" & s
    sRangeC = "Çalışma!c2:c" & s
    sRangeD = "Çalışma!e2:e" & s
    sRangeE = "Çalışma!f2:f" & s
    Criter1 = Format(Sheets("FİRMA").[C1], "00000")
    Criter2 = Format(Sheets("FİRMA").[C2], "00000")
        For j = 2 To 16 Step 2
                Criter3 = """" & Sheets("FİRMA").Cells(3, j) & """"
                For i = 4 To Sheets("FİRMA").[a65536].End(3).Row
                Criter4 = """" & Sheets("FİRMA").Cells(i, 1) & """"
                Sheets("FİRMA").Cells(i, j) = Evaluate("=SumProduct((" & sRangeA & ">=" & Criter1 & _
                                          ")*(" & sRangeB & "<=" & Criter2 & _
                                          ")*(" & sRangeC & "=" & Criter3 & _
                                          ")*(" & sRangeD & "=" & Criter4 & _
                                          ")*(" & sRangeE & "))")
            Next
        Next
MsgBox "Bitti."
End Sub
 
Hamit Hocam, cevabınız için teşekkür ederim.
s = Sheets("ÇALIŞMA").[a65536].End(3).Row veriable not defined diye bir hata verdi.
 
Kodun başında değişken tanımlamasını yapıp dener misiniz ?
Kod: 
dim s as long
 
Hocam ben çalıştıramadım. Sağlık olsun. Emeğinize sağlık.
 
Hamit Hocam, İhsan Beyin hazırladığı kodlar güzel oldu. İşlem tamam. Ancak sizin yazdığınız kodlar da sonuçlanırsa güzel bir örnek olacak. Tanımlamalarla ilgili bir sıkıntı var sanıyorum. İlk hatayı düzelttim bir alt satırda yine aynı hatayı verdi.
 
kelkitli' Alıntı:
Hamit Hocam, İhsan Beyin hazırladığı kodlar güzel oldu. İşlem tamam. Ancak sizin yazdığınız kodlar da sonuçlanırsa güzel bir örnek olacak. Tanımlamalarla ilgili bir sıkıntı var sanıyorum. İlk hatayı düzelttim bir alt satırda yine aynı hatayı verdi.
Genişletmek için tıkla ...

Hamitcan hocam kusura bakmayın gene kodunuzla oynadım
Kod başlığının üstüne yada altına
Kod: 
Dim s, sRangeA, sRangeB, sRangeC, sRangeD, sRangeE
Dim Criter1, Criter2, Criter3, Criter4, j, i
Bu tanımlamaları kopyalayın ve deneyin.
 
Elinize sağlık İhsan bey, düzeltmeler için.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst