اذهب الي المحتوي
أوفيسنا

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


إذهب إلى أفضل إجابة Solved by عادل حنفي,

الردود الموصى بها

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

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

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

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

 

رابط هذا التعليق
شارك

  • أفضل إجابة

السلام عليكم

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

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

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

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

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

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

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

تحياتي

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

  • Like 4
رابط هذا التعليق
شارك

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

رابط هذا التعليق
شارك

السلام عليكم

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

 بارك الله فيك

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

بارك الله فيك.png

رابط هذا التعليق
شارك

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

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

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

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

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

 

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

رابط هذا التعليق
شارك

السلام عليكم

الاخت ليلي

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

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

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

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

تحياتي

رابط هذا التعليق
شارك

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

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

Image3.jpg.94582810bf93d8f6df0311d0e52337b6.jpg

رابط هذا التعليق
شارك

السلام عليكم

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

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

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

رابط هذا التعليق
شارك

السلام  عليكم

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

اقتباس

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

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

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

السلام عليكم

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

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

تحياتي

رابط هذا التعليق
شارك

السلام عليكم

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

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

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

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

رابط هذا التعليق
شارك

  • 2 weeks later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information