Sayfaların toplamını alma.

[kelkitli]

Selamlar,
Ekteki dosyadaki sayfaların toplamlarını makro ile ilgili kutulara ay bazında almak istiyorum.
Saygılar.

 

[İhsan Tank]

Selamlar,
Ekteki dosyadaki sayfaların toplamlarını makro ile ilgili kutulara ay bazında almak istiyorum.
Saygılar.

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub aylık_plaka_topla_61()
On Error Resume Next
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi
Set bordo = Sheets("ARAÇTOPLAM")
trabzonspor = MsgBox("Araçların Aylık Toplamları Çıkarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
bordo.Range("B4:M" & Rows.Count).ClearContents
For ts = 4 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
Set mavi = Sheets(Replace(bordo.Cells(ts, "A").Text, " ", ""))
For kaplan = 2 To 13
For trabzonspor = 2 To mavi.Cells(Rows.Count, "B").End(xlUp).Row
If LCase(Format(mavi.Cells(trabzonspor, "B"), "mmmm")) = LCase _
(Replace(Replace(bordo.Cells(3, kaplan), "I", "ı"), "İ", "i")) Then
bordo.Cells(ts, kaplan) = bordo.Cells(ts, kaplan) + mavi.Cells( _
trabzonspor, "M")
End If
Next
Next
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Araçların Aylık Toplamları Çıktı", , "Bitiş"
End Sub

 

[İhsan Tank]

Üstteki kodu güncelledim.

 

[kelkitli]

İhsan Hocam,
Çok çok teşekkür ederim. Son satıra yıllık toplam imkanı varmı.

 

[assenucler]

Sayın İhsan Tank;

Merhabalar.

Katkınız için teşekkür ederim. Arşivime ekliyorum.

Sevgi ve saygılar.

 

[kelkitli]

İhsan Hocam birde şu durum var: Aranan öğe bulunamadığı zaman bir üstteki verileri bulamadığı araca yazıyor. Halbuki boş kalması gerekir. Birde toplamları soruyu sorarken unuttum.

 

[İhsan Tank]

İhsan Hocam birde şu durum var: Aranan öğe bulunamadığı zaman bir üstteki verileri bulamadığı araca yazıyor. Halbuki boş kalması gerekir. Birde toplamları soruyu sorarken unuttum.

Sorun nedir anlamadım. Daha açık yazar mısınız_?

 

[kelkitli]

Hocam,
durum şu: Örneğin bir araç plakası bir harf farklı farzedelim. Yani ARAÇTOPLAM sayfasına ekledik ama sayfa ismi olrak eklemeyi unuttuk. Makro çalışınca yeni eklediğimiz araca ait sayfayı bulamayınca bir önceki araca yazdığı veriyi tekrar bu aracada yazıyor. Bir diğer arz ettiğimde yıllık toplamlar.

 

[kelkitli]

Dosya ekte

 

[İhsan Tank]

Dosya ekte

Merhaba
Bu kodu dener misiniz_?
N sütununa Toplam alıyor şu an

Option Explicit
Sub aylık_plaka_topla_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi
Set bordo = Sheets("ARAÇTOPLAM")
trabzonspor = MsgBox("Araçların Aylık Toplamları Çıkarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
bordo.Range("B4:N" & Rows.Count).ClearContents
Range("N2") = ""
Range("N2") = Date
For ts = 4 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
Set mavi = Sheets(Replace(bordo.Cells(ts, "A").Text, " ", ""))
For kaplan = 2 To 13
For trabzonspor = 2 To mavi.Cells(Rows.Count, "B").End(xlUp).Row
If LCase(Format(mavi.Cells(trabzonspor, "B"), "mmmm")) = LCase _
(Replace(Replace(bordo.Cells(3, kaplan), "I", "ı"), "İ", "i")) Then
bordo.Cells(ts, kaplan) = bordo.Cells(ts, kaplan) + mavi.Cells( _
trabzonspor, "M")
End If
Next
Next
Next
For ts = 4 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
bordo.Cells(ts, "N") = WorksheetFunction.Sum(bordo.Range("B" & ts & ":M" & ts))
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Araçların Aylık Toplamları Çıktı", , "Bitiş"
End Sub

 

[kelkitli]

Teşekkür ederim İhsan Hocam.