تجميع بيانات

[mohamed.youssef]

السلام عليكم 

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

مع الشكر

KNTPROD.xlsxFetching info...

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

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

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

  في 7‏/11‏/2024 at 11:18, mohamed.youssef said:

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

Expand  

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

[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.xlsbFetching info...

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

[mohamed.youssef]

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

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

[mohamed.youssef]

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

KNTPROD V1.xlsmFetching info...

[محمد هشام.]

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

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

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

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

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

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

السلام عليكم

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

  في 7‏/11‏/2024 at 13:32, mohamed.youssef said:

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

Expand  

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

 

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

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

 

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

[mohamed.youssef]

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

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

KNTPROD V1.xlsmFetching info...

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

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

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

Expand  

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

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

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

Expand  

بهذا

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

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

KNTPROD V1.xlsbFetching info...

 

 

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

[محمد هشام.]

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

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.xlsmFetching info...