المطلوب تحويل المعادلة الى كود في ورقة دور ثان وناجح

[محمد زيدان2024]

المطلوب تحويل المعادلة الى كود في ورقة دور ثان وناجح

 

عمل المعادلات بكود.rar

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

السلام عليكم 

الكود

Sub ترحيل_الناجحين_والراسبين()
    Dim wsSource As Worksheet
    Dim wsPass As Worksheet
    Dim wsFail As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim passRow As Long
    Dim failRow As Long
    Dim passCount As Long
    Dim failCount As Long
    
    Set wsSource = ThisWorkbook.Sheets("اجمالي4")
    Set wsPass = ThisWorkbook.Sheets("ناجح4")
    Set wsFail = ThisWorkbook.Sheets("دور ثاني")
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    passRow = 7
    failRow = 7
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    wsPass.Rows("7:" & wsPass.Rows.Count).ClearContents
    wsFail.Rows("7:" & wsFail.Rows.Count).ClearContents
    For i = 5 To lastRow
        If InStr(1, LCase(wsSource.Cells(i, "BC").Value), "ناجح") > 0 Then
            wsPass.Cells(passRow, 2).Resize(1, 56).Value = wsSource.Cells(i, 2).Resize(1, 56).Value
            wsPass.Cells(passRow, 1).Value = passRow - 6
            wsPass.Cells(passRow, 1).NumberFormat = wsSource.Cells(i, 1).NumberFormat ' نسخ التنسيق
            passRow = passRow + 1
            passCount = passCount + 1
        ElseIf InStr(1, LCase(wsSource.Cells(i, "BC").Value), "راسب") > 0 Then
            wsFail.Cells(failRow, 2).Resize(1, 56).Value = wsSource.Cells(i, 2).Resize(1, 56).Value
            
            wsFail.Cells(failRow, 1).Value = failRow - 6
            wsFail.Cells(failRow, 1).NumberFormat = wsSource.Cells(i, 1).NumberFormat ' نسخ التنسيق
            failRow = failRow + 1
            failCount = failCount + 1
        End If
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    If passCount = 0 Then
        MsgBox "لا توجد سجلات ناجحة للترحيل."
    ElseIf failCount = 0 Then
        MsgBox "لا توجد سجلات راسبة للترحيل."
    Else
        MsgBox "تم ترحيل " & passCount & " ناجح(ة) و " & failCount & " راسب(ة) بنجاح."
    End If
End Sub

الملف

عمل المعادلات بكود1.xlsb