معادلة بدون تكرار لثلاثة أعمدة

[كمال على طارق]

السلام عليكم أساتذتى الكرام وكل عام وأنتم بخير وعيد أضحى سعيد على الجميع ... الرجاء من سيادتكم التكرم على مساعدتى بمعادلة لجلب البيانات من ثلاثة أعمدة بدون تكرار . بمعنى جلب بيانات العمود M من صفحة Data ,ووضعها بالعمود A بصفحة Total وبيانات العمود O واحضارها بالعمود B بصفحة Total وبيانات العمود P من صفحة Data ووضعها بالعمود C بصفحة Total .. وهناك نتيجة موجودة بالصفحة Total كمثال لما هو مطلوب  وجزاكم الله خير الثواب وبارك الله فى جهودكم

لابد الا يتكرر اسم الرحلة مع اسم المندوب لنفس التاريخ    وشكرا جزيلا

معادلة بدون تكرار.xlsx

[محمد هشام.]

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

إدن لنجرب المعادلة التالية في الخلية A2  ورقة TOTAL ضع المعادلة التالية

=LET(  data, Data!M2:P1000,  tour, INDEX(data,,1),  date_, INDEX(data,,3), guide, INDEX(data,,4),
  keys, UNIQUE(FILTER(tour & "|" & guide & "|" & TEXT(date_, "dd/mm/yyyy"), (tour<>"")*(guide<>"")*(date_<>0))),
rowNums, XMATCH(keys, tour & "|" & guide & "|" & TEXT(date_, "dd/mm/yyyy")), CHOOSE({1,2,3},INDEX(data, rowNums, 1),
TEXT(INDEX(data, rowNums, 3), "dd/mm/yyyy"),INDEX(data, rowNums, 4)  ))

 

أو يمكنك إستخدام الكود التالي 

في Module

Sub UpdateColArr()
    Const ColA = 1, ColB = 2, ColM = 13, ColO = 15, ColP = 16
    Dim OnRng, dict As Object, a(), key As String
    Dim i As Long, tmps As Long
    Dim WS As Worksheet: Set WS = Sheets("Data")
    Dim dest As Worksheet: Set dest = Sheets("Total")
    Set dict = CreateObject("Scripting.Dictionary")
    
    SetApp False
    With dest
        .Range("A1:E" & .Rows.Count).ClearContents
        .Range("A1").Resize(1, 5).Value = [{"Tour Name","Tour Date","Guide Name","Adl.","Chd"}]
        With .Range("A1:E1").Borders: .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic: End With
    End With
    
    OnRng = WS.Range("A2:P" & WS.Cells(WS.Rows.Count, ColM).End(xlUp).Row).Value
    ReDim a(1 To UBound(OnRng), 1 To 5)
    
    For i = 1 To UBound(OnRng)
        If Trim(OnRng(i, ColM)) <> "" Then
            key = OnRng(i, ColM) & "|" & OnRng(i, ColO) & "|" & OnRng(i, ColP)
            If Not dict.exists(key) Then
                tmps = tmps + 1
                a(tmps, 1) = OnRng(i, ColM): a(tmps, 2) = Format(OnRng(i, ColO), "dd/mm/yyyy")

                a(tmps, 3) = OnRng(i, ColP): a(tmps, 4) = Val(OnRng(i, ColA)): a(tmps, 5) = Val(OnRng(i, ColB))
                dict.Add key, tmps
            Else
                Dim n As Long: n = dict(key)
                a(n, 4) = a(n, 4) + Val(OnRng(i, ColA)): a(n, 5) = a(n, 5) + Val(OnRng(i, ColB))
            End If
        End If
    Next i

    If tmps > 0 Then dest.Range("A2").Resize(tmps, 5).Value = a
    SetApp True
    Set dict = Nothing: Set WS = Nothing: Set dest = Nothing
End Sub

Private Sub SetApp(ByVal enable As Boolean)
    On Error Resume Next
    With Application
        .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable
        .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual)
    End With
    On Error GoTo 0
End Sub

وفي حدث ورقة Sheet1

Private Sub Worksheet_Activate()
On Error Resume Next: Call UpdateColArr: On Error GoTo 0
End Sub

 

تم تعديل منذ 2 ساعات بواسطه محمد هشام.
إظافة إجمالي الأعمدة

[كمال على طارق]

شكرا جزيلا لكم وبارك الله فيك أستاذنا الكريم محمد هشام أحسنت وأبدعت كلا الحلان ممتازين  ولكنى أريد إجمالى الأعداد بهذان العمودان     

Adl  & Chd

 

معادلة بدون تكرار.xlsx

تم تعديل منذ 3 ساعات بواسطه كمال على طارق

[محمد هشام.]

2 ساعات مضت, كمال على طارق said:

ولكنى أريد إجمالى الأعداد بهذان العمودان     

Adl. CHD

لم تقم بدكر دالك ضمن المشاركة 

12 ساعات مضت, كمال على طارق said:

وهناك نتيجة موجودة بالصفحة Total كمثال لما هو مطلوب

في مثالك الورقة تتضمن أسماء عناوين الأعمدة فقط 

تم تعديل المعادلة والكود في المشاركة السابقة 

لحساب مجموع العمود  Adl.

=SUMIFS(Data!$A$2:$A$1000, Data!$M$2:$M$1000, A2, Data!$O$2:$O$1000, B2, Data!$P$2:$P$1000, C2)

أو 

=SUMIFS(Data!$A$2:$A$1000, Data!$M$2:$M$1000, A2, Data!$O$2:$O$1000, DATEVALUE(B2), Data!$P$2:$P$1000, C2)

لحساب مجموع العمود Chd

=SUMIFS(Data!$B$2:$B$1000, Data!$M$2:$M$1000, A2, Data!$O$2:$O$1000, B2, Data!$P$2:$P$1000, C2)

اليك ملفين الأول بالمعادلات والثاني بالأكواد يمكنك إختيار ما يناسبك 

 

 

 

 

 

معادلة بدون تكرار v2-vba .xlsb معادلة بدون تكرار v2.xlsx

تم تعديل منذ 2 ساعات بواسطه محمد هشام.
تعديل الكود و إظافة إجمالي الأعمدة

[كمال على طارق]

أحسنت وأحسن الله اليك وبارك الله فى جهودكم ووسع الله فى أرزاقكم -هو فعلاً المطلوب