حساب الضريبة

[2024HISHAMKAMAL]

يوجد بالشيت 1 الضريبة 

المطلوب ظهور مبلغ الضريبة بناء على قيمة الراتب والحالة الزوجية من جدول المعلومات 

ضريبة.xlsx

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

السلام عليكم 

الكود 

Sub CalculateTax()
    Dim wsInfo As Worksheet
    Dim wsEmployees As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim j As Integer
    Dim salary As Double
    Dim status As String
    Dim tax As Double
    Dim minSalary As Double
    Dim maxSalary As Double
    Dim found As Boolean
    
    Set wsInfo = ThisWorkbook.Sheets("المعلومات")
    Set wsEmployees = ThisWorkbook.Sheets("الموظفين")
    
    lastRow = wsEmployees.Cells(wsEmployees.Rows.Count, 2).End(xlUp).Row
    
    For i = 2 To lastRow
        salary = wsEmployees.Cells(i, 3).Value
        status = wsEmployees.Cells(i, 4).Value
        found = False
        For j = 3 To 6
            minSalary = wsInfo.Cells(j, 1).Value
            maxSalary = wsInfo.Cells(j, 2).Value
            
            If salary >= minSalary And salary <= maxSalary Then
                For Each cell In wsInfo.Range("C2:L2")
                    If cell.Value = status Then
                        tax = wsInfo.Cells(j, cell.Column).Value
                        wsEmployees.Cells(i, 5).Value = tax
                        found = True
                        Exit For
                    End If
                Next cell
                If found Then Exit For
            End If
        Next j
        
        If Not found Then
            wsEmployees.Cells(i, 5).Value = ""
        End If
    Next i
    
    MsgBox "تم حساب الضريبة بنجاح!", vbInformation
End Sub

الملف 

ضريبة.xlsb

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

وان اردتها بالمعادلات 

=IFERROR(
INDEX(المعلومات!C$3:L$6;MATCH(C2;المعلومات!A$3:A$6;1);MATCH(D2;المعلومات!C$2:L$2;0));
"غير متوفر"
)

 

1ضريبة.xlsb

[محمد هشام.]

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

بطريقة أخرى 

Sub TaxCivil()
    Dim Irow&, lastRow&, lastCol&, i&, j&, k&, WS As Worksheet, dest As Worksheet, tmp As Double, _
        OnRng As Variant, r As Variant, headers As Variant, n As Double, civil As String

    Set WS = Sheets("المعلومات")
    Set dest = Sheets("الموظفين")
    
    Application.ScreenUpdating = False

    Irow = dest.Cells(dest.Rows.Count, 3).End(xlUp).Row
    lastRow = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row
    lastCol = WS.Cells(2, WS.Columns.Count).End(xlToLeft).Column

    OnRng = dest.Range("A2:E" & Irow).Value
    r = WS.Range(WS.Cells(3, 1), WS.Cells(lastRow, lastCol)).Value
    headers = WS.Range(WS.Cells(2, 3), WS.Cells(2, lastCol)).Value

    dest.Range("E2:E" & Irow).ClearContents
    
    For i = 1 To UBound(OnRng, 1)
        n = OnRng(i, 3): civil = OnRng(i, 4)
        tmp = 0
        
        If n = 0 Or Trim(civil) = "" Then GoTo SkipRow
                For j = 1 To UBound(r, 1)
            If n >= r(j, 1) And n <= r(j, 2) Then
                For k = 1 To UBound(headers, 2)
                    If headers(1, k) = civil Then
                        tmp = r(j, k + 2)
                        Exit For
                    End If
                Next k
                Exit For
            End If
        Next j

        OnRng(i, 5) = IIf(tmp > 0, tmp, "غير محدد")

SkipRow:
    Next i

    dest.Range("A2").Resize(UBound(OnRng, 1), 5).Value = OnRng

    Application.ScreenUpdating = True
End Sub

 

ضريبة.xlsb