تعديل كود آخر لتقرير أخر

[أبوبسمله]

قمت بإنشاء تقرير أخر وهو تقرير خصم الراتب والعموله 

جلب الموظفين اللذين قامو  باجازات اكثر من 15 يوم فى شهر 30 يوم 

او جلب الموظفين اللذين قامو  باجازات اكثر من 16 يوم فى شهر 31 يوم 

او جلب الموظفين اللذين قامو  باجازات اكثر من 14 يوم فى شهر 29يوم 

ولكنى لم افلح فى ضبط الكود 

Dim H, I As Long, Found As Range
    Dim lRow As Long
    Set WS = Sheets("ÊÞÑíÑ ÎÕã ÇáÑÇÊÈ æÇáÚãæáå")
    Str = WS.Range("B3").Value And WS.Range("d3").Value
    lRow = 7
      Application.ScreenUpdating = False
           WS.Range("A7:C1000").ClearContents
        
            
            For H = 6 To Sheets.Count
           For I = 6 To Sheets.Count
            
             Set Found = Sheets(H).Columns("H:H").Find(Str)
              Set Found = Sheets(I).Columns("I:I").Find(Str)
              If Not Found Is Nothing Then
           
           
        If (Found.Offset(0, -1) > 4 And Sheets(H).Range("D5").Value >= 50) Or (Found.Offset(0, -1) > 3 And Sheets(H).Range("D5").Value < 50) Then
          
         
              WS.Cells(lRow, 1) = Sheets(H).Range("B3")
              WS.Cells(lRow, 2) = Sheets(H).Range("A1")
               WS.Cells(lRow, 3) = Found.Offset(0, -1)
                lRow = lRow + 1
              End If
                End If
      
        Next H
        Next I
            Application.ScreenUpdating = True

اعتذر لكم عن طلبات التعديل فليس لى خبره بكتابة الاكواد ولكن احاول 

2New2.rar

[ياسر خليل أبو البراء]

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

Sub Searches()
    Dim WS As Worksheet, str As String
    Dim I As Long
    Dim Found As Range

    Set WS = Sheets("تقرير خصم الراتب والعموله")
    str = WS.Range("B3").Value
    lRow = 7

    Application.ScreenUpdating = False
    
        WS.Range("A7:C1000").ClearContents
    
        For I = 6 To Sheets.Count
            Set Found = Sheets(I).Columns("H:H").Find(str)
    
            If Not Found Is Nothing Then
'الشروط المطلوبة
                If (Found.Offset(0, -1) > 16 And NumberOfDays(str) = 31) Or _
                   (Found.Offset(0, -1) > 15 And NumberOfDays(str) = 30) Or _
                   (Found.Offset(0, -1) > 14 And NumberOfDays(str) = 29) Then
    
                    WS.Cells(lRow, 1) = Sheets(I).Range("B3")
                    WS.Cells(lRow, 2) = Sheets(I).Range("A1")
                    WS.Cells(lRow, 3) = Found.Offset(0, -1)
                    lRow = lRow + 1
                End If
            End If
        Next I
    
    Application.ScreenUpdating = True
End Sub

Function NumberOfDays(str As String)
    If str = "" Then
        NumberOfDays = ""
    ElseIf str = "يناير" Or str = "مارس" Or str = "مايو" Or str = "يوليو" Or str = "أغسطس" Or str = "أكتوبر" Or str = "ديسمبر" Then
        NumberOfDays = 31
    ElseIf str = "أبريل" Or str = "يونيو" Or str = "سبتمبر" Or str = "نوفمبر" Then
        NumberOfDays = 30
    ElseIf str = "فبراير" Then
        NumberOfDays = 29
    End If
End Function

 

تم تعديل أغسطس 14, 2015 بواسطه ياسر خليل أبو البراء

[أبوبسمله]

جزاك الله كل خير 

بارك الله فيك اخى ياسر ويسر الله امرك كما تيسر علينا