ضبط وتعديل معادلة جلب بيانات الدولار أولا

[هانى محمد]

السلام عليكم أساتذتى الكرام الرجاء من سيادتكم مساعدتى بضبط هذه المعادلة لجلب بيانات عملة الدولار أولا ثم عملة الجنيه المصرى وذلك من صفحة Sheet1 الى صفحة Total كما هو وارد بالضبط بصفحة النتيجة المطلوبة  .. ولكم جزيل الشكر وبارك الله فى جهودكم جميعا

=IFERROR(INDEX(Sheet1!$A$2:$A$45,AGGREGATE(15,6,ROW($A$1:$A$310)/(MATCH(Sheet1!$A$2:$A$45&Sheet1!$A$2:$A$45,Sheet1!$A$2:$A$45&Sheet1!$A$2:$A$45,0)=ROW($A$1:$A$310)),ROWS($2:2))),"")

 

Suppliers.xlsx

[محمد هشام.]

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

 للحصول على النتائج بالترتيب المطلوب يمكنك استخدام الصيغة التالية للحصول على الأسماء التي تتضمن القيمة ب USD  في الخلية A3 

=UNIQUE(FILTER(Sheet1!A2:A45, Sheet1!G2:G45<>""))

وفي الخلية C3 

=IF(A3<>"", SUMIFS(Sheet1!$G$2:$G$45, Sheet1!$A$2:$A$45, A3), "")

مع سحبها لغاية اخر صف به بيانات من الأسماء المستخرجة 

وبعد اخر صف به بيانات على  العمود A ضع  المعادلة التالية  لجلب الأسماء التي تتضمن  EGP 

 

=UNIQUE(FILTER(Sheet1!A2:A45, Sheet1!F2:F45<>""))

وبنفس الطريقة في اخر خلية بها بيانات من عمود C 

=IF(A16<>"", SUMIFS(Sheet1!$F$2:$F$45, Sheet1!$A$2:$A$45, A16), "")

 

Suppliers.xlsx

 

أنصحك أخي @هانى محمد باستخدام الأكواد لتتمكن من الحصول على النتائج المطلوبة بطريقة ديناميكية دون تقييد لخلايا وضع المعادلات خاصة ادا كانت البيانات غير ثابتة وقابلة للزيادة مما سوف يساعدك على الإشتغال على الملف بشكل مرن ومطاطي وحصولك على النتائج بالترتيب المطلوب 

جرب هدا 

Option Explicit
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastRow As Long, n As Long, a As Collection, b As Collection
    Dim TotalG As Double, TotalF As Double, Kay As Variant, rng As Range
    Dim ColG As Variant, ColF As Variant, i As Long
    Dim Irow As Long, j As Variant, totals As Variant

   Dim WS As Worksheet: Set WS = Sheets("Sheet1")
   Dim dest As Worksheet: Set dest = Sheets("Total")

    If Not Intersect(Target, WS.Range("A2:G" & WS.Rows.Count)) Is Nothing Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        Application.EnableEvents = False

        On Error Resume Next
        Dim tbl As ListObject
        Set tbl = dest.ListObjects(1)
        If Not tbl Is Nothing Then
            tbl.Unlist
        End If
        On Error GoTo 0
        LastRow = dest.Cells(dest.Rows.Count, "A").End(xlUp).Row
        If LastRow >= 3 Then
            dest.Range("A3:D" & LastRow).Clear
        End If
        If dest.Cells(2, "A").Value = "" Then
            dest.Range("A2:D2").Value = Array("Supplier Name", "Cheque Name", "Amount", "Curr")
        End If

        LastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
        ColG = Application.Transpose(WS.Range("G2:G" & LastRow).Value)
        ColF = Application.Transpose(WS.Range("F2:F" & LastRow).Value)
        
        Set a = New Collection: Set b = New Collection
        On Error Resume Next
        For i = 2 To LastRow
            If ColG(i - 1) <> "" Then a.Add WS.Cells(i, "A").Value, CStr(WS.Cells(i, "A").Value)
            If ColF(i - 1) <> "" Then b.Add WS.Cells(i, "A").Value, CStr(WS.Cells(i, "A").Value)
        Next i
        
        On Error GoTo 0
        n = 3
        For Each Kay In a
            dest.Cells(n, "A").Value = Kay
            dest.Cells(n, "C").Value = Application.WorksheetFunction.SumIf _
                 (WS.Range("A2:A" & LastRow), Kay, WS.Range("G2:G" & LastRow))
            
            dest.Cells(n, "D").Value = "USD"
            TotalG = TotalG + dest.Cells(n, "C").Value
            n = n + 1
        Next Kay

        For Each Kay In b
            dest.Cells(n, "A").Value = Kay
            dest.Cells(n, "C").Value = Application.WorksheetFunction.SumIf _
                (WS.Range("A2:A" & LastRow), Kay, WS.Range("F2:F" & LastRow))
            
            dest.Cells(n, "D").Value = "EGP"
            TotalF = TotalF + dest.Cells(n, "C").Value
            n = n + 1
        Next Kay
        
        totals = Array("Total USD", TotalG, "Total EGP", TotalF)
        n = n + 1

         j = Array("USD", "EGP")
        
        For i = LBound(totals) To UBound(totals) Step 2
            dest.Cells(n + (i / 2), "A").Value = totals(i)
            dest.Cells(n + (i / 2), "C").Value = totals(i + 1)
            dest.Cells(n + (i / 2), "D").Value = j(i / 2)
        Next i
        
        For i = 3 To n - 1
            dest.Cells(i, "C").NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        Next i
        Irow = n + (UBound(totals) \ 2)
        Set tbl = dest.ListObjects.Add(xlSrcRange, dest.Range("A2:D" & Irow), , xlYes)
        tbl.Name = "ResultsTable"
        tbl.TableStyle = "TableStyleLight19"

           For i = Irow - 2 To Irow - 1
            With tbl.Range.Rows(i).Borders
                .LineStyle = xlContinuous
                .Color = RGB(0, 0, 0)
                .Weight = xlMedium
            End With
            Next i
            
        Set rng = dest.Range("D3:D" & n - 1)
        With rng.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""EGP""")
            .Interior.Color = RGB(255, 192, 203)
            .Font.Color = RGB(255, 0, 0)
        End With

        With tbl.Range.Columns("B:D")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End If
End Sub

 

 

 

Suppliers VBA .xlsb

تم تعديل أكتوبر 18 بواسطه محمد هشام.

[هانى محمد]

أحسنت وأحسن الله اليك كلا الطريقتين ممتازة . بارك الله فيك وزادك الله من فضله وأكرمك الله كما أكرمتنى وفرج الله كرباتك ووسع الله فى رزقك ورزقك من غير لا تحتسب