فرز بيانات

[أزهر]

السلام عليكم

لدي الملف المرفق مثالاً لما هو مطلوب تحقيقه

 

المعطيات: جدول (بيانات 1): يحتوي على بيانات النوع والجهة والرقم

المطلوب: هو فرز البيانات الموجودة بالجدول (بيانات 1) وذلك بحسب العنوان الموجود في الجدول (بيانات 2) وتكون النتيجة كما هو مذكور في جدول (بيانات 2) والرقم يتم تجميع الأرقام

الشرط: عدم تكرار نفس النوع والجهة معاً، وإذا تكررا يقوم بجمع أرقامهما كما في المثال المرفق

 

 

Book1.xlsx

تم تعديل منذ 22 ساعات بواسطه أزهر
تعديل الملف

[محمد هشام.]

4 ساعات مضت, أزهر said:

وذلك بحسب العنوان الموجود في الجدول (بيانات 2)

هل تقصد ان جدول البيانات 2/  النوع و الجهة   موجودة مسبقا  على الجدول فقط  يتم تجميع الأرقام و الشرط: عدم تكرار نفس النوع والجهة معاً

ادا كان هدا ما تقصده يكفي وضع المعادلة التالية في عمود H 

=IF(AND(G4<>"", F4<>""), IFERROR(SUMIFS(D4:D100, C4:C100, G4, B4:B100, F4), ""), "")

أما إدا كنت ترغب  باستخراج البيانات بالشكل الواضح في الصورة بدون وضع بيانات مسبقا استخدم الكود التالي  في حدث ورقة 1

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Intersect(Target, Me.Range("B4:D" & Me.Rows.Count))
    If Not rng Is Nothing Then
        TotalNonTri
    End If
End Sub
Sub TotalNonTri()
    Dim a() As Variant, i&, lig&, key As Variant, tmp As Variant
    Dim WS As Worksheet, d As Object, tbl As Variant, n As String

    Set d = CreateObject("Scripting.Dictionary")
    Set WS = Sheets("Sheet1")
    
    tbl = Range("B4:D" & Cells(Rows.Count, "B").End(xlUp).Row).Value
    
    Application.ScreenUpdating = False
    WS.Range("F4:H" & WS.Rows.Count).ClearContents

    For i = LBound(tbl, 1) To UBound(tbl, 1)
        If Not IsEmpty(tbl(i, 1)) And Not IsEmpty(tbl(i, 2)) Then
            n = tbl(i, 1) & "|" & tbl(i, 2)

            If d.Exists(n) Then
                d(n) = d(n) + tbl(i, 3)
            Else
                d(n) = tbl(i, 3)
            End If
        End If
    Next i

    ReDim a(1 To d.Count, 1 To 3)
    lig = 1
    For Each key In d.Keys
        tmp = Split(key, "|")
        a(lig, 1) = tmp(0): a(lig, 2) = tmp(1): a(lig, 3) = d(key)
        lig = lig + 1
    Next key

    With Range("F4").Resize(d.Count, UBound(a, 2))
        .Value = a
    End With
    Application.ScreenUpdating = True
End Sub

 

 

 

Book1.xlsb

[أزهر]

جزاك الله كل خير

ما كنت أقصده هو ما تفضلت به (باستخراج البيانات بالشكل الواضح في الصورة بدون وضع بيانات مسبقا) والكود يعمل بشكل صحيح