تعديل لدالة جلب اخر قيمة في عمود

[ضياء 2]

السلام عليكم الأساتذة الافاضل بالمنتدى فضلا من كرمكم " المطلوب تعديل لهذه الدالة لجلب اخر قيمة في عمود B في ورقة رئيسي 200 تخصم منها اخر قيمة في عمود B وهي 198 المطلوب  النتيجة هي 2 علبة  الدالة موجودة في خلية B1 "

ورقة.xlsx

[AbuuAhmed]

عمل لك دالة بالكود
 

Function getBalance()
    getBalance = Sheets("رئيسي ").Range("B2").End(xlDown) - _
                 Sheets("ورقة1").Range("B2").End(xlDown)
End Function

 

getBalance_01.xlsm

تم تعديل يناير 25 بواسطه AbuuAhmed

[ضياء 2]

شكرا استاذنا AbuuAhmed على تفاعلكم ولكن انا قصرت في شرح المطلوب جيد " الدالة عندي تعمل جيد عندي صرف كمية 1000 فقط في ورقة رئيسي النتيجة بتكون مظبوطة بشرط تكون كلمة اول في خلية A1 مقابل لها في عمود c ولكن المشكلة عند اضافة كمية ثانية اقل من 1000 منالكمية السابقة كمثال 200  في ورقة رئيسي النتيجة بتكون النتيجة خطا

[محمد هشام.]

جرب وضع الصيغة التالية 

=IFERROR(LOOKUP(2,1/('رئيسي '!$A$2:$A$17="كرتونة صنف "&$A$1),'رئيسي '!$B$2:$B$17)-LOOKUP(2,1/($C$2:$C$20=$A$1),$B$2:$B$20)&" "&"علبة","")

 

ورقة 2.xlsx

[AbuuAhmed]

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

Function getBalance(DumpNum) As Long
    getBalance = Sheets("رئيسي ").Range("B1").End(xlDown) - _
                 Sheets("ورقة1").Range("B1").End(xlDown)
End Function

 

getBalance_02.xlsm

[محمد هشام.]

حياك الله استاد @AbuuAhmed لقد قمت بتجربة الدالة الخاصة بك فعلا هي تشتغل بشكل جيد لاكن على حسب ما فهمت انا  ان الاخ  @ضياء 2 طلبه يتمثل في  جلب اخر قيمة بشرط الخلية A1   لنفترض انه  تم تغيير القيمة الى الثاني مثلا او الثالث واظافة صنف مغاير وليكن كرتونة صنف الثاني  يجب جلب اخر قيمة من ورقة الرئيسي مع خصم اخر قيمة من ورقة 1 بشرط القيمة الموجودة في الخلية A1   ونوعية الصنف ربما والله اعلم 

 

 

 

getBalance_03.xlsm

[AbuuAhmed]

حياك الله أستاذ @محمد هشام. هذه دالتي بعد فهمي لشرحك وإضافتك مزيد من البيانات المتنوعة.
 

Function getBalance(DumpVal) As Long
    Dim sht1 As Worksheet, main As Worksheet
    Dim lrow As Integer, row As Integer
    Dim unit As String
    
    Set sht1 = Sheets("ورقة1")
    Set main = Sheets("رئيسي ")
    
    With sht1
        lrow = .Range("B1").End(xlDown).row
        unit = .Cells(lrow, 3)
        getBalance = .Cells(lrow, 2)
    End With
    
    With main
        lrow = .Range("B1").End(xlDown).row
        For row = lrow To 2 Step -1
            If .Cells(row, 1) Like "*" & unit Then
                getBalance = .Cells(row, 2) - getBalance
                Exit For
            End If
        Next row
    End With
    
    Set sht1 = Nothing
    Set main = Nothing
End Function

 

getBalance_04.xlsm

تم تعديل يناير 27 بواسطه AbuuAhmed

[محمد هشام.]

 مجهود تشكر عليه استاذ احمد 

 محاولة بطريقة اخرى  ربما تتضح الفكرة   في انتظار  التوضيح اكثر من صاحب الملف 

=(INDEX('رئيسي '!B:B,MAX(('رئيسي '!$A$2:$A$100="كرتونة صنف "&$A$1)*ROW($A$2:$A$100)*('رئيسي '!$B$2:$B$100<>""))))-(INDEX(B:B,MAX(($C$2:$C$100=$A$1)*ROW($C$2:$C$100)*($B$2:$B$100<>""))))&" "&"علبة"

 

 

 

getBalance 6.xlsm

[AbuuAhmed]

أدخلت تعديل على الدالة ولكن هي تعمل بنفس الأسلوب
التعديل أن تعطي القيمة "" في حالة عدم وجود وحدة القياس وتعطي الناتج بالسالب في حالة لم يجد نفس الوحدة.
صاحب الموضوع يا أنه تاه أو أنه مل، إن شاء الله يرجع لنا سريعا.
 

Function getBalance(DumpVal) As Variant
    Dim sht1 As Worksheet, main As Worksheet
    Dim lrow As Integer, row As Integer
    Dim unit As String
    
    Set sht1 = Sheets("ورقة1")
    Set main = Sheets("رئيسي ")
    
    getBalance = ""
    
    With sht1
        lrow = .Range("B1").End(xlDown).row
        unit = Trim(.Cells(lrow, 3))
        If unit = "" Then Exit Function
        getBalance = -.Cells(lrow, 2)
    End With
    
    With main
        lrow = .Range("B1").End(xlDown).row
        For row = lrow To 2 Step -1
            If .Cells(row, 1) Like "*" & unit Then
                getBalance = .Cells(row, 2) + getBalance
                Exit For
            End If
        Next row
    End With
    
    Set sht1 = Nothing
    Set main = Nothing
End Function

 

getBalance_07.xlsm

[ضياء 2]

 شكرا لمجهودكم وسعة صدركم استاذنا الكريم AbuuAhmed و شكرا استاذنا الغالي  محمد هشام. وفيتم وكفيتم