ارجو المساعده لاهمية الامر

[omerahmed5]

السادة / اعضاء المنتدي المحترمين 

السلام عليكم ورحمة الله وبركاته فضلا وليس امرا المساعدة في ايجاد دالة  تفي المطلوب في شيت الاكسل المرفق 

المطلوب كالاتي اذا كان المبلغ في العمود B يساوي 500 او اقل والعمود A اكبر من 3000 نضرب العمود A  في واحد ونصف (1.5)  واذا العمود B اكبر من 500 والعمود A اكبر من 3000 نضرب العمود A في (2.5)  واذا  كان B اقل من 500 وA اقل من 3000 نضع في العمود  C  مبلغ 6000 

test2025.xlsx

تم تعديل الأربعاء at 12:09 بواسطه omerahmed5

[عبدالله بشير عبدالله]

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

العمود c كود    

Sub CalculateValues()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim colA As Double
    Dim colB As Double
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    For i = 1 To lastRow
        colA = ws.Cells(i, "A").Value
        colB = ws.Cells(i, "B").Value
        
        If colB <= 500 And colA > 3000 Then
            ws.Cells(i, "C").Value = colA * 1.5
        ElseIf colB > 500 And colA > 3000 Then
            ws.Cells(i, "C").Value = colA * 2.5
        ElseIf colB < 500 And colA < 3000 Then
            ws.Cells(i, "C").Value = 6000
        Else
            ws.Cells(i, "C").Value = ""
        End If
    Next i

End Sub

العمود d معادلة

=IF(B1<500; IF(A1>3000; A1*1.5; 6000); IF(A1>3000; A1*2.5; ""))

test2025.xlsb

[محمد هشام.]

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

بعد إدن الأستاد  @عبدالله بشير عبدالله  إليك حلول أخرى 

=IF(A1>3000, A1*IF(B1<=500, 1.5, 2.5), IF(B1<500, 6000, ""))

 

=IFERROR(IFS(
    AND(A1>3000, B1<=500), A1*1.5,
    AND(A1>3000, B1>500), A1*2.5,
    AND(A1<=3000, B1<500), 6000,
    TRUE, ""
), "")

او 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("A:B")) Is Nothing Then
        Dim data As Variant, tmp() As Variant, lastRow As Long, i As Long
        Dim a As Double: a = 3000: b = 500: c = 6000
        lastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
        data = Me.Range("A1:B" & lastRow).Value
        ReDim tmp(1 To UBound(data, 1), 1 To 1)
        
        For i = 1 To UBound(data, 1)
            If IsEmpty(data(i, 1)) Or IsEmpty(data(i, 2)) Then
                tmp(i, 1) = ""
            ElseIf IsNumeric(data(i, 1)) And IsNumeric(data(i, 2)) Then
                If data(i, 1) > a Then
                    tmp(i, 1) = IIf(data(i, 2) <= b, data(i, 1) * 1.5, data(i, 1) * 2.5)
                ElseIf data(i, 2) < b Then
                    tmp(i, 1) = c
                Else
                    tmp(i, 1) = ""
                End If
            Else
                tmp(i, 1) = ""
            End If
        Next i
        Me.Range("C1:C" & lastRow).Value = tmp
    End If
End Sub

 

test2025.xlsb

تم تعديل الأربعاء at 14:47 بواسطه محمد هشام.

[omerahmed5]

ينساق مني القول جبرا واعترافا وعرفانا بما يقدمه هذا المنتدي الشامخ من فائدة عظيمة اقسم بالله انا استفدت كثيرا  جزاكم الله خيرا وجعله في ميزان حسناتكم لكل خبراء واعضاء هذا المنتدي