تحديد صافي الدخل اليومي

[خليل القيسي]

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

 

تصفيات العيادات.xlsx

[خليل القيسي]

محتاج من حضراتكم معادلة لعمل المطلوب من فضلكم 

[Foksh]

6 ساعات مضت, خليل القيسي said:

محتاج من حضراتكم معادلة لعمل المطلوب من فضلكم 

أخي الكريم ، الفكرة ليست بمعادلة وينتهي الموضوع !!!!

بناءً على ملفك المرفق فإنه حتى المعادلة لن تأتي لك بالمطلوب لأسباب كثيرة .

1. نمط التاريخ وشكله وتنسيقه غير واضح في الخلايا داخل الورقات اليومية .
2. الخلية التي سيكون بها تاريخ المقارنة يجب أن يكون في خلية ثابتة في جميع الورقات .
3. خلية عرض الصافي أيضاً يجب أن تكون في خلية ثابتة . فليس من المنطقي أن تكون مرة في Q ومرة في R ومرة في F ... إلخ

وعليه تم العمل من خلال ماكرو واستدعاؤه داخل الورقة الرئيسية كالتالي :-

Sub GetValuesFromSheets()
    Dim wsCurrent As Worksheet
    Dim wsOther As Worksheet
    Dim i As Long
    Dim j As Long
    Dim targetDate As Date
    Dim found As Boolean
    Dim lastRow As Long
    
    Set wsCurrent = ThisWorkbook.ActiveSheet
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    wsCurrent.Range("C3:C33").ClearContents
    
    For i = 3 To 33
        If wsCurrent.Cells(i, "B").Value <> "" Then
            If IsDate(wsCurrent.Cells(i, "B").Value) Then
                targetDate = CDate(wsCurrent.Cells(i, "B").Value)
                found = False
                
                For Each wsOther In ThisWorkbook.Worksheets
                    If wsOther.Name <> wsCurrent.Name Then
                        lastRow = wsOther.Cells(wsOther.Rows.Count, "B").End(xlUp).Row
                        If lastRow > 33 Then lastRow = 33
                        
                        For j = 3 To lastRow
                            If wsOther.Cells(j, "B").Value <> "" Then
                                If IsDate(wsOther.Cells(j, "B").Value) Then
                                    If CDate(wsOther.Cells(j, "B").Value) = targetDate Then
                                        wsCurrent.Cells(i, "C").Value = wsOther.Range("R27").Value
                                        found = True
                                        Exit For
                                    End If
                                End If
                            End If
                        Next j
                    End If
                    If found Then Exit For
                Next wsOther
                
                If Not found Then
                    wsCurrent.Cells(i, "C").Value = "غير موجود"
                End If
            End If
        End If
    Next i
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Activate()
    Call GetValuesFromSheets
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B3:B33")) Is Nothing Then
        Call GetValuesFromSheets
    End If
End Sub

 

وهذا مرفقك بعد إجراء بعض التعديلات عليه وضبط المواضع التي تحدثت عنها سابقاً

تصفيات العيادات.xlsm

ملاحظة .. تم تعديل التاريخ في كل ورقة ليصبح

2026-06-19

2026-06-20

2026-06-21

2026-06-22