كود توزيع الملاحظين

[2saad]

إخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته

هذا الملف مساهمة مني لهذا الصرح العظيم وللأعضاء الذين لهم أفضال كثيرة علي والذي ساعدني فيه ( الاستاذ محمد هشام وأخي ابراهيم صديقي )سعد.xlsm

هذا الملف لرجال التعليم في توزيع الملاحظين علي اللجان بنظام الفترات أنا صممته للابتدائي

اليوم   والفترة وهي تعني ( المادة )    4و5 تعني الصف الرابع والخامس     6 تعني الصف السادس

يا ريت الخبراء يقيموه ولو فيه تعديل يكون أفضل من الخبراء

[محمد هشام.]

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

 

Sub Compare()
    Dim lr As Long, i As Long, j As Long
    Dim strCol As String
    Dim WS As Worksheet: Set WS = Worksheets("Sheet1")
    
    Application.ScreenUpdating = False
    
    lr = WS.Columns("A:R").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    'Columns C to R
    For i = 3 To 18
        strCol = Split((WS.Columns(i).Address(, 0)), ":")(0)
        For j = 5 To lr
            If WorksheetFunction.CountIf(WS.Range(strCol & "5:" & strCol & lr), WS.Range("A" & j)) = 0 Then
                WS.Cells(Rows.Count, strCol).End(xlUp).Offset(1).Value = WS.Range("A" & j).Value
            End If
        Next j
    Next i
    
    Application.ScreenUpdating = True

End Sub

 بالتوفيق...........

[2saad]

بارك الله فيك وأكثر الله من أمثالك