هل يمكن هذا بالاكسل !!!

[hassan951]

يوجد لدى شيت لكل موقع

 البيانات فيه تدرج يدويا

فكيف فى شيت ( اجمالى يومى )

ينظر الى التاريخ المطابق فى كل شيت من موقع 1 الى موقع 5 ويجمعهم فى شيت ( اجمالى يومى )

مع الاعتبارعند جمع ال كجم يرحل الزائد الى طن لكل فئه من ( 22.5 - 23 - 23.5 )

وكيف فى شيت ( مواقع يومى ) 

يطابق التاريخ المسجل بالاعلى والماخوذ من تاريخ الجهاز

ويرحل الارقام من كل موقع على حده فى التاريخ المحدد

وكيف فى شيت ( مواقع بالفترات )

يطابق التاريخ المسجل بالاعلى من ............ الى ...........

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

بالجدول مع وضع كل خانه فى مقابلها

الرجاااااااااااااااء المساعده ضرورى

وكل عام وانتم بخير

ملف جمع خاص.xlsx

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

في الخلية B3 من الصفجة (اجمالي يومي) اكتب هذه المعادلة( كما في الصورة)

ثم اسحب يساراً 6 اعمدة و نزولا حتى الصف 89

الملف مرفق

Hasan.xlsx

[hassan951]

شكرا اخى للاهتمام

الملف المرفق يوجد به بيانات

وارفقته مره اخرى لك الان واضفت بيانات زياده

باختصار

كيف اقوله انظر فى عامود التاريخ فى كل شيت من 1 الى 5

و قارنه بتاريخ مواقع يومى فاذا تساوى التاريخين

قم بجمع قيم الخانات المقابله للتاريخ فى كل شيت

وضع النتائج فى شيت ( مواقع يومى )

فكره اخرى نسيتها 

وهيه فى شيت ( مواقع بالفترات )

كيف اقوله انظر فى عامود التاريخ فى كل شيت من 1 الى 5

و قارنه بتاريخ مواقع بالفترات بحيث يجمع فقط البيانات من كل شيت

المقابله للتاريخ  من .................. الى  ..................

ويضعها فى شيت ( مواقع بالفترات )

حيث انه متغير لعمل تقرير بالكميات فى هذه الفترات

.................. هل الفكره ممكنه

لقد ميزت الشيتين المراد العمل عليهما باللون الاخضر

وشكرا مره اخرى لرد الكريم واهتمامك

ساتغيب قليلا وساعود باذن الله قبل المغرب ان شاء الله تعالى 

تحياتى

ملف جمع خاص.xlsx

حاولت ب sumif و  sumifs

ولم تفلح معى ولم افهم لما

هل لانى فاصل ال كجم عن الطن ام ماذا

لانى البيانات لابد ان تكون مفصوله ال كجم عن الطن

وشكرا

تم تعديل أبريل 17, 2021 بواسطه hassan951

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

تم تعديل اسماء الضفحات الى  Reg  اي Region وذلك من اجل حسن نسخ الكود ولصقه
دون مشاكل اللغة العربية وطهور أحرف غريبة فيه

فقط اضغط الزر Run

Option Explicit
Sub All_In_One()
Dim SH(), itm, My_sh As Worksheet
Dim T As Worksheet
Dim Ro%, Sb#, Sc#, Sd#, Se#, Sf#, Sg#, k%, n%
Dim ads%
Dim F_rg As Range, Wat
Set T = Sheets("Total")
k = T.Cells(Rows.Count, 1).End(3).Row
If k < 3 Then Exit Sub
T.Range("B3").Resize(k - 2, 6).ClearContents
SH = Array("Reg1", "Reg2", "Reg3", "Reg4", "Reg5")
 For n = 3 To k
       Wat = T.Range("A" & n)
       For Each itm In SH
         Set My_sh = Sheets(itm)
            Ro = My_sh.Cells(Rows.Count, 1).End(3).Row
            If Ro < 3 Then GoTo Next_Itm
            Set F_rg = My_sh.Range("A2:A" & Ro).Find(Wat, Lookat:=1)
            If F_rg Is Nothing Then GoTo Next_Itm
            ads = F_rg.Row
            Sb = Sb + Val(My_sh.Cells(ads, "B"))
            Sc = Sc + Val(My_sh.Cells(ads, "C"))
            Sd = Sd + Val(My_sh.Cells(ads, "D"))
            Se = Se + Val(My_sh.Cells(ads, "E"))
            Sf = Sf + Val(My_sh.Cells(ads, "F"))
            Sg = Sg + Val(My_sh.Cells(ads, "G"))
Next_Itm:
      Next itm
       With T.Cells(n, 2)
        .Value = Sb: Sb = 0
        .Offset(, 1) = Sc: Sc = 0
        .Offset(, 2) = Sd: Sd = 0
        .Offset(, 3) = Se: Se = 0
        .Offset(, 4) = Sf: Sf = 0
        .Offset(, 5) = Sg: Sg = 0
        End With
 Next n
End Sub

الملف مرفق

Hasan.xlsm

[hassan951]

ممتاز اخى ولك كل الشكر والتقدير لمجهودك

انا افتكرت الموضوع هيتم بالدوال العاديه ولكنه كود وصعب افهمه

ولكن فى الاجمالى انت غيرت من تصميم الجدول

الجدول الاجمالى انا لم ارد الايام

ولكن المواقع الخمسه وتحت الزر مكان لكتابه التاريخ الذى سيتم سحب البيانات منه

اذا كان يوم فردى ومكانين ( من ........ الى .............. )

اذا اردت تقرير عن فتره ما

لذااااااااااااااااا

فلك جزيل الشكر هحاول ان افهم الكود واجرب حتى اصل الى ما اريد

شكرا لك جزيلا لتعاونك

فانت انجزت لى الكثير وساتعلم منك الكثير 

فلك جزيل الشكر مره اخرى 

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

الملف من جديد مع  اختيار التاريخ من   الى  في الحلايا  L2 و M2

في حال الخطأ بكتابة  التواريخ في  L2 او M2    او ادراح تواريخ غير موجودة في البيانات يقوم الماكرو بادراج كل التواريخ من اصغرها الى اكبرها

اذا كنت تريد يوما واجداً اجعل  L2 و M2  متساويتين  (مثلا لاختيار 10 ابريل اكتب    10/4/2021 في L2 و M2)

Option Explicit
Sub All_In_One()
Dim SH(), itm, My_sh As Worksheet
Dim T As Worksheet
Dim Sb#, Sc#, Sd#, Se#, Sf#, Sg#
Dim ads%, k%, n%, Ro%, Max_row%
Dim X As Date
Dim Dat1 As Date, Dat2 As Date
Dim F_rg As Range, Wat
Set T = Sheets("Total")

Max_row = Sheets("Reg1").Cells(Rows.Count, 1).End(3).Row
 If Not IsDate(T.Range("L2")) Or _
    IsError(Application.Match(T.Range("L2"), _
     Sheets("Reg1").Range("A3:A" & Max_row), 0)) Or _
     IsError(Application.Match(T.Range("M2"), _
     Sheets("Reg1").Range("A3:A" & Max_row), 0)) Then
    Dat1 = Application.Min(Sheets("Reg1").Range("A3:A" & Max_row))
    Dat2 = Application.Max(Sheets("Reg1").Range("A3:A" & Max_row))
    T.Range("L2") = Dat1: T.Range("M2") = Dat2
 Else
    Dat1 = Application.Min(T.Range("L2"), T.Range("M2"))
    Dat2 = Application.Max(T.Range("L2"), T.Range("M2"))
    T.Range("L2") = Dat1: T.Range("M2") = Dat2
 End If
k = T.Cells(Rows.Count, 1).End(3).Row
If k < 3 Then Exit Sub
T.Range("A3").Resize(k - 2, 7).ClearContents
SH = Array("Reg1", "Reg2", "Reg3", "Reg4", "Reg5")
 For X = Dat1 To Dat2
  T.Range("A3").Offset(n) = Dat1 + n
  n = n + 1
 Next
 k = T.Cells(Rows.Count, 1).End(3).Row

 For n = 3 To k
       Wat = T.Range("A" & n)
       For Each itm In SH
         Set My_sh = Sheets(itm)
            Ro = My_sh.Cells(Rows.Count, 1).End(3).Row
            If Ro < 3 Then GoTo Next_Itm
            Set F_rg = My_sh.Range("A2:A" & Ro).Find(Wat, Lookat:=1)
            If F_rg Is Nothing Then GoTo Next_Itm
            ads = F_rg.Row
            Sb = Sb + Val(My_sh.Cells(ads, "B"))
            Sc = Sc + Val(My_sh.Cells(ads, "C"))
            Sd = Sd + Val(My_sh.Cells(ads, "D"))
            Se = Se + Val(My_sh.Cells(ads, "E"))
            Sf = Sf + Val(My_sh.Cells(ads, "F"))
            Sg = Sg + Val(My_sh.Cells(ads, "G"))
Next_Itm:
      Next itm
       With T.Cells(n, 2)
        .Value = Sb: Sb = 0
        .Offset(, 1) = Sc: Sc = 0
        .Offset(, 2) = Sd: Sd = 0
        .Offset(, 3) = Se: Se = 0
        .Offset(, 4) = Sf: Sf = 0
        .Offset(, 5) = Sg: Sg = 0
        End With
 Next n
End Sub

الملف من جديد

Hasan_Choise.xlsm