تجميع الشهور للمنتجات

[Mostafa Moawad]

السلام عليكم

مرفق ملف به 12 شيت للشهور وشيت لإجمالي الشهور بكل شيت مبيعات المنتجات للشهر والمطلوب الحصول على اجمالي المبيعات بشيت YTD لكل منتج ولكن بشرط جمع كل الشهور التي قبل شيت Month وعند تحريك شيت Month يتغير الجمع

يرجى استخدام الرموز البديله Wild cards ثم نسخ الدلة بخلية اخرى باستخدام Formula text للتمكن من معرفة الدالة المستخدمة

ان امكن استخدام اكثر من طريقة لكون شاكر ليكم جدا

YTD Products.xlsx

[سليم حاصبيا]

  Try This Formula in the cell B2 sheet(YTD)  and  Copy Down

=SUM(Jan:Dec!B2)

file Included

 

 

YTD_ Products.xlsx

[Mostafa Moawad]

متشكر جدا على ردك لكن انا عايز الجمع يكون من اول يناير لحد شيت Month اي حتى شهر ابريل فقط وكل مره احرك شيت month يتم تعديل الجمع مره اخرى

[سليم حاصبيا]

هكذا عمل لا يمكن للمعادلة ان تتحكم به لانه متعلق بموقع الشيت  Month  والله أعلم

يمكن عمل ما تريد بواسطة الماكرو

كما في الملف المرفق

الكود

Option Explicit

Sub Free_summation()
Dim M As Worksheet
Dim M_index
Dim first_index%, t%
Dim S2#, S3#, S4#, S5#, S6#
Set M = Sheets("Month")
Dim Arr()
M_index = M.Index
If M_index = 1 Then Exit Sub
If M_index > =13 Then M_index = 13
For t = 1 To M_index - 1
 S2 = S2 + IIf(IsNumeric(Sheets(t).Range("B2")), _
   Sheets(t).Range("B2"), 0)
 S3 = S3 + IIf(IsNumeric(Sheets(t).Range("B3")), _
   Sheets(t).Range("B3"), 0)
 S4 = S4 + IIf(IsNumeric(Sheets(t).Range("B4")), _
   Sheets(t).Range("B4"), 0)
 S5 = S5 + IIf(IsNumeric(Sheets(t).Range("B5")), _
   Sheets(t).Range("B5"), 0)
 S6 = S6 + IIf(IsNumeric(Sheets(t).Range("B6")), _
   Sheets(t).Range("B6"), 0)
Next
Arr = Array(S2, S3, S4, S5, S6)
M.Range("B2").Resize(UBound(Arr) + 1) = _
Application.Transpose(Arr)
End Sub

 

 

Moustafa.xlsm

[سليم حاصبيا]

في حال كان عدد الصفوف كبيراً (اكثر من  10 ) وقتها يجب ان نعين الكثير من المتغيرات S1/S2/....... /S20

و أرى ان هذا الأمر يأخذ كود طويل جداَ

لذلك اقترح هذا الكود الذي يحدد اوتوماتيكياً عدد الصفوف و يحمعها في Array

Option Explicit
Sub Free_summation_1()
Dim M As Worksheet
Dim M_index
Dim t%, k%
Dim lr%
Dim Arr()
lr = Sheets("Jan").Cells(Rows.Count, 2).End(3).Row
 For k = 2 To lr
  ReDim Preserve Arr(k - 2)
  Arr(k - 2) = 0
 Next
Set M = Sheets("Month")

M_index = M.Index
If M_index = 1 Then Exit Sub
If M_index > 12 Then M_index = 13
For t = 1 To M_index - 1
  For k = LBound(Arr) To UBound(Arr)
     Arr(k) = Arr(k) + _
     IIf(IsNumeric(Sheets(t).Range("B" & k + 2)), _
     Sheets(t).Range("B" & k + 2), 0)
  Next k
Next t
M.Range("B2").Resize(UBound(Arr) + 1) = _
Application.Transpose(Arr)
End Sub

ما أقصده في هذا الملف

Moustafa_extra.xlsm