تعديل كود الترحيل ليتناسب مع ملفي

[ليلى الهلالي]

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

خواتم مباركة ومرضية

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

Sub Export_Workbooks_Using_Filter()
'Author  : YasserKhalil
'Release : 07 - 09 - 2016
'------------------------
    Dim a           As Variant
    Dim I           As Long
    Dim P           As Integer
    Dim cnt         As Integer
    Dim Dic         As Object
    Dim strDir      As String
    Dim Arr()       As Double
    Dim iFlag       As Boolean

    '=========================================================
    Const firstCol  As Long = 1             'First Column
    Const lastCol   As Long = 4             'Last Column
    Const colNo     As Long = 1             'Column To Filter
    Const sSheet    As String = "Sheet1"    'Sheet Name
    '=========================================================

    strDir = ThisWorkbook.Path & "\Output\"
    For P = firstCol To lastCol
        ReDim Preserve Arr(P - 1)
        Arr(P - 1) = Sheets(sSheet).Columns(P).ColumnWidth
    Next P
    iFlag = Sheets(sSheet).DisplayRightToLeft

    Call SpeedUp
        If Dir(strDir, vbDirectory) = "" Then MkDir strDir
    
        Sheets.Add before:=Sheets(1)
        Set Dic = CreateObject("Scripting.Dictionary")
        Dic.CompareMOde = 1
    
        With Sheets(sSheet).[A1].CurrentRegion
            .Columns(colNo).Value = Application.Trim(.Columns(colNo).Value)
            a = .Value
            .Parent.AutoFilterMode = False
    
            For I = 2 To UBound(a, 1)
                If Not Dic.exists(a(I, colNo)) And Not IsEmpty(a(I, colNo)) Then
                    Dic(a(I, colNo)) = Empty
                    .AutoFilter colNo, a(I, colNo)
                    .Copy Sheets(1).Cells(1)
                    Sheets(1).Copy
    
                    With ActiveWorkbook
                        With Sheets(1)
                            .Name = "Sheet1"
                            .DisplayRightToLeft = iFlag
                            .Cells(1).CurrentRegion.RowHeight = 19
                            For cnt = firstCol To lastCol
                                .Columns(cnt).ColumnWidth = Arr(cnt - 1)
                            Next cnt
                        End With
    
                        .SaveAs strDir & RemoveSpecial(CStr(a(I, colNo))) & ".xlsx"
                        .Close
                    End With
    
                    Sheets(1).Cells.Clear
                    .AutoFilter
                End If
            Next I
        End With
    
        Sheets(1).Delete
    Call SpeedDown

    MsgBox "Done...", 64
End Sub

Function RemoveSpecial(sInput As String) As String
    Dim sSpecialChars   As String
    Dim I               As Long

    sSpecialChars = "\/:*?""<>|"
    For I = 1 To Len(sSpecialChars)
        sInput = VBA.Trim(Replace$(sInput, Mid$(sSpecialChars, I, 1), " "))
    Next I

    RemoveSpecial = sInput
End Function

Function SpeedUp()
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
End Function

Function SpeedDown()
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Function

 

[أحمد يوسف]

وعليكم السلام -لابد من رفع ملف العمل حتى تتمكن الأساتذة من المساعدة

[ليلى الهلالي]

السلام عليكم

أعتذر لعدم تحميل المرفق حيث توقف النت لديّ

 

حافظة الدوام أوفيسنا.rar

[عادل حنفي]

السلام عليكم

ارجو تجربة المرفق وقد تم مراعاة معظم المشاكل

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

يكون العمل مادة القرآن الكريم وليس القران تحت قسم مادة القرآن الكريم

وقد تم عمل الملف بطريقة يسهل تعاملك معه بالرغم  من انه استغرق 3 ايام لفكرة صغيرة وهي كيفية التعرف علي الاقسام والصف الاخير في كل قسم

اخيرا بنفس طريقة عملك لهذا الملف صممي الملف الذي سيتم عليه عملك الفعلي والصقي نسحة فارغة من البيانات وليس من  الاقسام في شيت Source

فهو الشيت الذي يعتمد عليه لعمل نسخة لكل مدرسة

ارجو انني قد فهمت المطلوب ونفذ بالطريقة الصحيحة ولو فيه اي استفسار انا منتظر للرد عليه

تحياتي

حافظة الدوام أوفيسنا.rar

[وجيه شرف الدين]

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

[عادل حنفي]

استاذ وجيه لك كل الشكر علي كلماتك ومرورك

[يوسف عطا]

الأستاذ عادل حنفى

حفظه الله

رجل المهام الصعبة

[عادل حنفي]

حبيبي يا جو مشكور علي مرورك

تحياتي

تم تعديل يونيو 1, 2019 بواسطه عادل حنفي

[ليلى الهلالي]

السلام عليكم

أستاذي الفاضل عادل حنفي

 بارك الله فيك

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

[ليلى الهلالي]

On 5/31/2019 at 4:42 AM, عادل حنفي said:

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

يكون العمل مادة القرآن الكريم وليس القران تحت قسم مادة القرآن الكريم

أستاذي الفاضل. لم أفهم هذه النقطة حيث أن لدي ورقة البيانات الأصلية فيها تسميات المواد الدراسية قرآن، اسلامية،لغة عربية، لغة انجليزية وهكذا. ما فهمته أنني يجب أن أُعدل التسميات في ورقة العمل الأساسية وهذا صعب حيث أننا نقوم بعمل موحد ولا أستطيع تغيير التسميات التي اتقفنا على التعامل بها

مرسل لك نموذج البيانات التي تأتي منه بيانات الحافظة المدرسية، قام بعمل الاكود الأستاذ ياسر خليل في موقع الصقر 

 

القوى بالاكواد.rar

[عادل حنفي]

السلام عليكم

الاخت ليلي

المقصود اعتقد انه بسيط ولكنه مهم فانه عند توزيع البيانات يتم المقارنه بين القسم (والمقصود به هنا البيان المكتوب في كل خلية مدمجة في شيت         حافظة الدوام كالاداريين ومادة القران الكريم وعام1-3(مربي).....وهكذا) وبين التخصص لكل موظف ويجب التطابق بينهما فاذا تم هذا الشرط فعند توزيع البيانات سينتقل الاسم تحت القسم المتطابق مع التخصص علما بان اي تخصص غير موجود له قسم سيتم انزاله تحت قسم الاداريين وانتي لن تغيري في تخصص كل موظف لا بل ستغيري في اسماء بنود الخلايا الدمجة فقط لتتطابق مع التخصص

وان استحال الامر ارسلي ملف يوضح التخصصات الغير متطابقة مع القسم كالتالي

القران        مادة القران الكريم وهكذا

ارجو اني استطعت ايصال المعلومة

تحياتي

[عادل حنفي]

طبعا مع خالص تقدير للاستاذ الفاضل ياسر خليل فهو صديق عزيز ولكني لم اري الملف الذي يعمل كوده عليه وليس لدي من الوقت لقراءة كوده وتتبع عمله لذا كان لابد ومن الاسهل كتابة ما يتماشي مع مافهمته لملفك

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

[ليلى الهلالي]

السلام عليكم

كل عام وأنتم بخير وعيدكم مبارك

أعتذر لعدم الدخول سابقاً لظروف العيد

أستاذي الفاضل هل من طريقة أخرى لتعديل أسماء المواد مثلاً أن أغير أسماء الخلايا المدمجة بدلاً عن تغيير أسماء المواد في الحافظة لأن الحافظة مرتبطة بقاعدة البيانات ونحن نستورد البيانات منها 

[عادل حنفي]

السلام  عليكم

الاخت الفاضلة

اقتباس

أستاذي الفاضل هل من طريقة أخرى لتعديل أسماء المواد مثلاً أن أغير أسماء الخلايا المدمجة بدلاً عن تغيير أسماء المواد في الحافظة لأن الحافظة مرتبطة بقاعدة البيانات ونحن نستورد البيانات منها 

هذا بالفعل ما اقصده المهم ان يكون  اسماء المواد هو نقسه الموجود بالخلايا المدمجة 

تم تعديل يونيو 9, 2019 بواسطه عادل حنفي

[ليلى الهلالي]

السلام عليكم

أستاذي الفاضل عادل

حاولت تغيير أسماء الخلايا المدمجة ولكن صادفني الآتي

لدي مواد اللغات وهي تنقسم للغة الانجليزية والفرنسية والالمانية وحتى أستطيع تغيير تسمية الخلايا المدمجة سوف اضطر لتفصيل المواد كل مادة على حدة. المسألة هنا أن مادتي الفرنسي والألماني لا تُدرس في جميع المدارس وبالتالي سوف يتم ترحيل الخلية المدمجة دون أسماء مدرسين تحتها مما سأُضطر لمسحها يدوياً

وهذا أيضاً ينطبق على المواد العلمية(العلوم، كيمياء، فيزياء، أحياء) والاجتماعية( اجتماعيات، تاريخ، جغرافيا، المواد الفسلفية...... وغيرها) ففيها عدة مواد وجميعها تندرج تحت مسمى واحد

ولك جزيل الشكر.

[عادل حنفي]

عذرا علي التاخير

يمكنك ارسال ملف يحتوي علي عامودان الاول به اسم المادة والعامود الاخر به ما يقابلها في الخلايا المدمجة  مثلا

العامود الاول يكتب به قران والعامود  المقابل يكتب به مادة القران الكريم وهكذا لكل المواد التي لا تتساوي مع ما يقابلها في الخلايا المدمجة وكذلك  يجب معرفة المواد التي تشترك تحت مسمي واجد

ذلك لمحاولة  مساعدتك وتعديل  الكود علي ذلك 

تحياتي

[ليلى الهلالي]

السلام عليكم

أسعد الله أوقاتكم بكل خير

أستاذي الفاضل عادل

تم إرسال المرفق وقد أوضحت فيه المطلوب . وقد جعلني كرمك وحِلمك عليَّ بأن أطمع في طلبين وضحتهما في المرفق. إن كان بإمكانك تنفيذهما فلك جزيل الشكر وإن استصعبت المسألة فلك جزيل الشكر أيضاً ولا داعي أن تتعب نفسك. فقد كفيت ووفيت وجُزيت خيراً عن كل ما قدمته وتقدمه لرواد هذا المنتدى.

المواد المدجمة أوفيسنا.xlsx

[ليلى الهلالي]

للرفع