تجميع بيانات

[mohamed.youssef]

السلام عليكم 

السادة الكرام الملف المرسل محتاج في صفحة KN بيانات محتاج اعدل عليها في صفحة MM بحيث تكون مرتبطة بالالوان كما هو موضح كل رقم بجانبه التاريخ من يوم 1 الى يوم 31 وكمية كل تاربخ تخت اليوم كما هو موضح باللون الاصفر  

مع الشكر

KNTPROD.xlsx

[عبدالله بشير عبدالله]

,وعليكم السلام

توجد نقطة مهمة وهي 

منذ ساعه, mohamed.youssef said:

كل رقم بجانبه التاريخ من يوم 1 الى يوم 31 وكمية كل تاربخ تخت اليوم كما هو موضح باللون الاصفر

توجد تواريخ مكررة اين توضع كمياتها كما في مثالك  

[mohamed.youssef]

المكرر يتم تجميعه بنفس التاريخ

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته 

جرب هدا 

Sub ItemsRollKgmsKnt()
Dim d1 As Object, d2 As Object
Dim OnRng() As Variant, a, g, d As Variant
Dim tmp As Integer, n As Integer, mx As Integer
Dim WS As Worksheet: Set WS = Sheets("KN")

    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")

    a = WS.Range("A2:A" & WS.[A65000].End(xlUp).Row).Value
    g = WS.Range("G2:G" & WS.[A65000].End(xlUp).Row).Value
    d = WS.Range("D2:D" & WS.[A65000].End(xlUp).Row).Value
    
    For i = 1 To UBound(a, 1)
        If IsNumeric(a(i, 1)) And a(i, 1) <> "" Then
            If Not d1.exists(a(i, 1)) Then d1(a(i, 1)) = d1.Count + 1
        End If
    Next i
    
    mx = 31
    ReDim OnRng(1 To d1.Count, 1 To mx + 1)
    
    For i = 1 To UBound(a, 1)
        If IsNumeric(a(i, 1)) And a(i, 1) <> "" Then
            n = d1(a(i, 1))
            tmp = Day(CDate(d(i, 1)))
            
            If tmp >= 1 And tmp <= 31 Then
                OnRng(n, 1) = a(i, 1)
                
                If OnRng(n, tmp + 1) = "" Then
                    OnRng(n, tmp + 1) = g(i, 1)
                Else
                    OnRng(n, tmp + 1) = OnRng(n, tmp + 1) & "-" & g(i, 1)
                End If
            End If
        End If
    Next i
  With Sheets("MM")
    .Range("A2").Resize(d1.Count, mx + 1).Value = OnRng
    .Columns.AutoFit
    End With
End Sub

 

KNTPROD V1.xlsb

تم تعديل نوفمبر 7 بواسطه محمد هشام.

[mohamed.youssef]

النتيجة في الملف الاخر بها مشكلة عند الضغط على الزر وترحيل البيانات تكون غير صحيحة

استاذي الفاضل الصفحة الاولى يوجد بها عمود للتاريخ محتاج في الصفحة الاخرى تجميع كل رقم بتاريخه من الي

[mohamed.youssef]

الملف كما هو في الشرح الجمالي متداخل مع بعضه 

KNTPROD V1.xlsm

[محمد هشام.]

أخي @mohamed.youssef   للعلم  إحتمال 90% من حصولك على إجابة صحيحة تكمن في  طريقة طرح طلبك

الصيغة التي قمت بطرح بها طلبك في أول مشاركة  (التعديل وربط الألوان.... )  كيف نفهم نحن أنك تريد جلب التواريخ من إلى 

إذن الكود المقترح يقوم بجلب القيم الفريدة من عمود A ونسخ القيم من عمود G بشرط التاريخ وعند وجود تواريخ مكررة يتم دمج القيم المتعلقة بها في خلية واحدة مثلا 156-456.....  وهكذا  

أما طلبك الحالي التاريخ من إلى 

يرجى إرفاق عينة لشكل البيانات المتوقعة للتوضيح وان شاء الله سوف نحاول مساعدتك 

[عبدالله بشير عبدالله]

السلام عليكم

الاستاذ محمد هشام  اهنئك على الكود  الرائع

1 ساعه مضت, mohamed.youssef said:

محتاج في الصفحة الاخرى تجميع كل رقم بتاريخه

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

 

                    OnRng(n, tmp + 1) = OnRng(n, tmp + 1) & "-" & g(i, 1)
بدل الشرطة بربد جمعة
OnRng(n, tmp + 1) = OnRng(n, tmp + 1) + g(i, 1)

هذا حسب فهمى لطلبه والله اعلم وننتظر رأيه في الامر

 

تم تعديل نوفمبر 7 بواسطه عبدالله بشير عبدالله

[mohamed.youssef]

انا اعتزر لسيادتكم المطلوب نفس الطريقة اللي سيادتكم ارسلتوها ولكن انا محتاج نتيحة تكرار التاريخ يكون حاصل الجمع مرة واحدة في خانة واحدة على اساس يكون رقم صحيح 

اعتزر مرة اخرى 

KNTPROD V1.xlsm

[عبدالله بشير عبدالله]

في 9‏/11‏/2024 at 08:30, mohamed.youssef said:

انا محتاج نتيحة تكرار التاريخ يكون حاصل الجمع مرة واحدة في خانة واحدة على اساس يكون رقم صحيح

استبدل هذا الجزء في كود الاستاذ محمد هشام

في 7‏/11‏/2024 at 17:26, عبدالله بشير عبدالله said:

OnRng(n, tmp + 1) = OnRng(n, tmp + 1) & "-" & g(i, 1)

بهذا

OnRng(n, tmp + 1) = OnRng(n, tmp + 1) + g(i, 1)

الملف   ( اذا تحقق طلبك بهذا الملف فصاحب الكود يستحق افضل اجابة وهو استاذنا محمد هشام)

KNTPROD V1.xlsb

 

 

تم تعديل نوفمبر 10 بواسطه عبدالله بشير عبدالله

[محمد هشام.]

كما سبق الدكر من الأستاد @عبدالله بشير عبدالله يكفي تعديل هدا السطر للحصول على مجموع كل تاريخ 

OnRng(n, tmp + 1) = OnRng(n, tmp + 1) + g(i, 1)

 

لاكن قبل الجمع  وتفديا للأخطاء يجب أولا  التحقق من البيانات على العمود (G)  لان وجود بيانات غير رقمية من شأنه أن يسبب أخطاء 

Sub ItemsRollKgmsKnt()
    Dim d1 As Object, d2 As Object
    Dim OnRng() As Variant, a, g, d As Variant
    Dim tmp As Integer, n As Integer, mx As Integer
    Dim WS As Worksheet: Set WS = Sheets("KN")
    Dim f As Worksheet: Set f = Sheets("MM")
    
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    
    a = WS.Range("A2:A" & WS.[A65000].End(xlUp).Row).Value
    g = WS.Range("G2:G" & WS.[A65000].End(xlUp).Row).Value
    d = WS.Range("D2:D" & WS.[A65000].End(xlUp).Row).Value
    
    Application.ScreenUpdating = False
    f.Range("A2:AF" & f.Rows.Count).ClearContents
    
    For i = 1 To UBound(a, 1)
        If IsNumeric(a(i, 1)) And a(i, 1) <> "" Then
            If Not d1.exists(a(i, 1)) Then d1(a(i, 1)) = d1.Count + 1
        End If
    Next i
    
    mx = 31
    ReDim OnRng(1 To d1.Count, 1 To mx + 1)
    
    For i = 1 To UBound(a, 1)
        If IsNumeric(a(i, 1)) And a(i, 1) <> "" Then
            n = d1(a(i, 1))
            tmp = Day(CDate(d(i, 1)))
            
            If tmp >= 1 And tmp <= 31 Then
                OnRng(n, 1) = a(i, 1)
                
                If IsNumeric(OnRng(n, tmp + 1)) And IsNumeric(g(i, 1)) Then
                    OnRng(n, tmp + 1) = OnRng(n, tmp + 1) + Round(g(i, 1), 0)
                Else
                    OnRng(n, tmp + 1) = Round(g(i, 1), 0)
                End If
            End If
        End If
    Next i

    With f
        .Range("A2").Resize(d1.Count, mx + 1).Value = OnRng
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

 

 

KNTPROD V2.xlsm