مسح صفوف في اوراق مختلفه مره واحده

[ناصر سعيد]

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

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

 

=========

 

نسخ صفوف و المسح.rar

والمرفق يوضح اكثر

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

[ناصر سعيد]

للرفع للساده العمالقه المحترمين

[ناصر سعيد]

الحل جاء من المحترم ياسر العربي

 'هذا الكود للمحترم ياسر العربي
 ' الهدف من الكود هو نسخ صف الى صفوف تحته بالعدد المطلوب
 'وقبل النسخ يتم مسح البيانات القديمه
 'تاريخ الانشاء 30/7/2017
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Private Sub CommandButton1_Click()
    Dim sh As Worksheet, lr As Long, str As String
    If TextBox1.Text = Sheets("بيانات الطلبة").Range("F1") Then
        Me.Hide
        TextBox1.Text = ""
        MsgBox "كلمة المرور صحيحة و سيتم تنفيذ المطلوب"
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        'اذا كان عدد المتقدمين اقل من اتنين يتم ايقاف الكود ولا يكمل
        If Sheets("بيانات الطلبة").Cells(2, 3) < 2 Then
            Exit Sub
        End If
        '=*=*=*=*=*=*
            'On Error Resume Next
 For Each sh In Sheets(Array("بيانات الطلبة", "إنجاز1", "تحريرى ف 1", "تحريرى ف 2", "أعمال السنة", "كشف الدور الثاني", "كشف ناجح"))

            lr = sh.Range("B" & sh.Range("b10000").End(xlUp).Row).Row
            sh.Activate
            ' str المتغير دا يتم تخزين اسم العمود الاخير فيه للعمل عليه
            'يتم الذهاب الى اخر عمود بالاعتماد على الصف السادس  ويتم استخلاص اسم العمود من اسم النطاق
   str = Split(sh.Range("XFD7").End(xlToLeft).Address, "$")(1)
            'حذف البيانات الموجودة في النطاق المحدد
            sh.Range("A8:" & str & lr + 7).Clear
            '   نسخ الصف السابع لكل شيت من حيث عدد الاعمدة الى العدد المحدد بعدد المتقدمين
            sh.Range("a7:" & str & 7).AutoFill Destination:=Range("a7:" & str & [    'بيانات الطلبة'!C2] + 6)
        Next
      Sheets("بيانات الطلبة").Select
    Range("A4").Select

        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Unload Me
    Else
        MsgBox "عفوا كلمة المرور خاطئة و لن يتم تنفيذ المطلوب"
        TextBox1.Text = ""
        TextBox1.SetFocus
    End If
End Sub

Private Sub Label1_Click()

End Sub

Private Sub UserForm_Click()

End Sub

جزاه الله عنا خير الجزاء

 

================

نسخ صفوف.rar

[ناصر سعيد]

بعض النقاط لهضم الكود

XFD7

خليتها 7 ليه بالرغم من ان صف البدايه 9 والذي يسبقه 8
2- مامعنى هذه

Address, "$")(1)

الاجابه من المحترم ياسر العربي

اولا  XFD7  دا اخر نطاق للاعمدة

 و7 دي عشان رؤوس الاعمدة  

انا بحسب عليها لان الرؤوس موجود بها البيانات

ممكن اخر خليه  في الصف 9 ميكنش فيها بيانات فيبدأ النسخ من داخل النطاق عند اول خليه بها بيانات
XFD7  دا اخر عمود من جهه اليسار بقول له روح للخليه دي واضغط على زر End  وبعدها سهم يمين يذهب تلقائي الى اول عمود به بيانات من جهه اليسار
Address, "$"(1)  ودا جزء من كود لفصل اسم العمود عن رقم الصف بمعنى هنا الادرس دا بيجيب عنوان الخليه كدا $A$1
فالكود بيفصل اسم العمود ليصبح هكذا A   ويتم تخزين هذاا لعمود في المتغير  Str  حتى نستعمله في النسخ والحذف لكل ورقة عمل

[قصي]

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

[قصي]

انت فين يا ابو العربي ؟

 

منتظرين مزيدا من الشرح لهذه الجزئيه ربنا يبارك لك

[ناصر سعيد]

للرفع

 

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

السلام عليكم

تفضل أخي ناصر شرح السطر الذي طلبته ولكن بأسلوب آخر .. قم بنسخ الكود في موديول عادي ، ونفذ الكود باستخدام F8 ليتم تنفيذ الكود سطر بسطر وتتعلم ماذا يحدث مع كل سطر

Sub Test()
    'تعريف المتغير من النوع ورقة عمل
    Dim sh As Worksheet

    'تعريف المتغير من النوع نطاق
    Dim rng As Range

    'تعريف المتغير من النوع النصي
    Dim str As String

    'تعريف متغير ليحمل القيم التي سيتم تقسيمها في النص وسيكون بمثابة مصفوفة
    Dim x As Variant
    
    'تعيين قيمة لمتغير ورقة العمل ليشير لورقة العمل المسماة "بيانات الطلبة" ونستخدم المتغير في الكود
    Set sh = Sheets("بيانات الطلبة")
    
    
    'تعيين قيمة للمتغير ليساوي آخر عمود في الصف السابع
    '[XFD7] للانتقال من نقطة البداية وهي [xlToLeft] حيث تستخدم كلمة
    'إلى أول عمود جهة اليسار والذي يعتبر آخر عمود به بيانات في الصف السابع
    'قبل اسم المتغير الذي يشير للنطاق [Set] لاحظ عند تعيين نطاق يتم استخدام كلمة
    'وبعد علامة يساوي يتم الإشارة إلى ورقة العمل ثم النطاق
    Set rng = sh.Range("XFD7").End(xlToLeft)

    'يمكن من خلالها معرفة عنوان النطاق [Address] الخاصية
    'لإظهار العنوان في رسالة [MsgBox] استخدم كلمة [rng] ولذلك إذا أردت معرفة عنوان النطاق المسمى
    '[$F$7] إذا قمت بتنفيذ هذا السطر ستجد أن عنوان النطاق هو
    'يمكن الحصول على عنوان النطاق بدون علامة الدولار عن طريق استخدام السطر التالي
    'MsgBox rng.Address(0, 0)
    'أي يتم وضع قوسين وما بين القوسين نضع صفر ثم فاصلة ثم صفر
    MsgBox rng.Address
    
    'نفس السطر السابق وهذا هو خلاصة ما سيتم تقسيمه في السطر التالي في الشرح
    MsgBox sh.Range("XFD7").End(xlToLeft).Address
    
    'لعمل تقسيم للنص بناءً على فاصل محدد [Split] تستخدم الدالة
    'الفاصل هنا الذي سيتم التقسيم على أساسه هو علامة الدولار
    'لاحظ أن الفاصل يوضع بين أقواس تنصيص
    '[Locals Window] عند تنفيذ هذا السطر انظر في نافذة
    'View >> Locals Window
    'ستجد أن المتغير يحمل القيم التي تقسيمها بهذا الشكل
        'x(0)   >>      ""
        'x(1)   >>      "F"
        'x(2)   >>      "7"
    'تم تقسيمه لثلاثة أجزاء وهذا بسبب وجود علامة الدولار مرتين [$F$7] أي أن العنوان
    '[F] الجزء الذي يهمنا هنا في الكود هو رمز العمود أي حرف
    '[x(1)] وهذا تواجد في التقسيم الثاني ألا وهو
    x = Split(rng.Address, "$")
    
    'بهذا نكون قد وصلنا للسطر المطلوب حيث يتم تخزين رمز العمود في متغير نصي
    str = Split(sh.Range("XFD7").End(xlToLeft).Address, "$")(1)

    'إظهار رمز العمود في رسالة
    MsgBox str
End Sub

 

[ناصر سعيد]

اخي الكريم استاذ باسر

لو فرضنا ان عدد الاعمده في الصفحه بيانات اساسيه  هي 10 اعمده وفي الصفحة الاخرى 15 وهكذا فوجدنا ان اكبر عدد اعمده في الملف في صفحة ما  هو مثلا للعمود hh

السوال : هل نكتب في صفحه بيانات الطلبه في العمود hh  اي رقم حتى يتعرف الكود على مدى المسح ومدى النسخ  ؟

 

 السوال التاني : اذا بدأنا من العمود a او العمود B او العمود C

هل يتاثر الكود بعدم العمل مضبوطا ؟

السوال التالت

        'x(0)   >>      ""
        'x(1)   >>      "F"
        'x(2)   >>      "7"

مافائده التقسيم للكود ؟

واحنا بنختار الصف السابع او التامن على اي اساس

هل هو اول صف بعد الترويسه دائما ؟

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

 

تم تعديل أغسطس 5, 2017 بواسطه ناصر سعيد

[ناصر سعيد]

عند كتابه عدد كبير وليكن 200 طالب

يتم عمل الكود ولكن بعدها اكتب عدد صغير مثل 3

لايتم المسح جيدا وانما يتم مسح 4 صفوف بعد العدد الصغير ويترك باقي التسطير

لماذا ؟

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

بالنسبة لرقم الصف أعتقد أن الأخ ياسر العربي اعتمد على أول صف الذي يلي صف العناوين (الذي أسميته الترويسة)

أنا لم أطلع على  الكود بالكامل ولذلك لا يمكنني الرد على استسفاراتك كلها .. 

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

هذا والله الموفق

[ناصر سعيد]

جزاك الله خيرا وبارك فيك ندعو الله ان يعين عليها

يتبقى عده اسئله

لو فرضنا ان عدد الاعمده في الصفحه بيانات الطلبه هي 10 اعمده وفي الصفحة الاخرى 15 وهكذا فوجدنا ان اكبر عدد اعمده في الملف في صفحة ما  هو مثلا للعمود hh

السوال : هل نكتب في صفحه بيانات الطلبه في العمود hh  اي رقم حتى يتعرف الكود على مدى المسح ومدى النسخ  ؟

=== اذا بدأنا من العمود a او العمود B او العمود C

 السوال التاني : هل يتاثر الكود بعدم العمل مضبوطا ؟

===

عند كتابه عدد كبير وليكن 200 طالب

يتم عمل الكود ولكن بعدها اكتب عدد صغير مثل 3

لايتم المسح جيدا وانما يتم مسح 4 صفوف بعد العدد الصغير ويترك باقي التسطير

لماذا ؟

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

ممكن سؤال سؤال عشان أقدر أجاوبك 

دلوقتي إنت عايز تحدد عدد الأعمدة بناءً على مدخل في خلية أم بناءً على الكود .. يعني الكود اللي يحدد ولا إنت اللي هتحدد عدد الأعمدة؟

[ناصر سعيد]

بناءً على الكود .. الكود اللي يحدد عدد الأعمدة كل صفحه من صفحات الملف ؟

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

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

هل يوجد صفحات مستثناة ..أم أن كل الصفحات نفس الهيكلة .. أحتاج لملف مرفق بسيط وليس الملف الأصلي توضح فيه النقطة المطلوبة فقط لأستطيع العمل عليها 

واذكر التفاصيل .. هل الحلقات التكرارية ستكون على كل أوراق العمل أم أن هناك أوراق عمل لا تدخل ضمن الحلقة ؟؟ وهل الصف سيكون دائماً الصف رقم 7 أم لا ..؟ لابد أن تكون أوراق العمل بنفس الهيكلة

جرب الملف التالي .. عله يفيدك

 

Sample.rar

[ناصر سعيد]

هذا هو الملف والمهم فيه هو الترويسه ( صف العناوين )  والصف الذي يليه

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

 

النسخ والمسح.rar

=================

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

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

هل اطلعت على المشاركة السابقة والملف المرفق .. لأنك لم تعلق عليه ، حاول أن تتبع نفس الأسلوب

في ورقة العمل "كنترول شيت" وورقة العمل "كنترول شيت (2)" وورقة العمل "رصد الترم الأول" وورقة العمل "Sheet1" ليسوا بنفس الهيكلة أي أن البيانات لا تبدأ من الصف السابع كبقية الأوراق . فهل هذه أوراق سيتم استثنائها؟

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

[ناصر سعيد]

اخي الكريم

استثني الاوراق التي لاتبدا من الصف السابع بعد العناوين

ونحن عندما نحصل على كود سنطوع الرؤوس في الصفحات المطلوبه في صف واحد

نريد ان نحصل على كود يودي نفس الغرض لكود الاستاذ ياسر العربي

وانما يبتعد عن مشكله  اذا وضعت عدد ظلاب كثير وليكن 200 ثم اردت ان تغير لعدد بسيط وليكن 3 فلا يتم المسح مضبوطا

( ايه اللي بيحصل )  يتم مسح 4 اسطر اسفل العدد المطلوب وباقي الصفوف مازالت موجوده

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

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

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

[ناصر سعيد]

====

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

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

أخي العزيز ناصر 

جرب الكود التالي عله يفي بالغرض ... امسح الأكواد الموجودة في الموديولات لأن هناك كودين بنفس الاسم Test وهذا لا يجوز ..

ضع الكود التالي في حدث الفورم بعد مسح الكود القديم ، والشكر موصول للأخ الغالي ياسر العربي صاحب الفكرة الرائعة

Private Sub CommandButton1_Click()
    Dim ws      As Worksheet
    Dim sh      As Worksheet
    Dim lr      As Long
    Dim lc      As Long
    Dim c       As Long
    
    Set ws = Sheets("بيانات الطلبة")
    c = ws.Range("Q1").Value
    
    If TextBox1.Text = ws.Range("F1") Then
        Me.Hide
        TextBox1.Text = ""
        MsgBox "كلمة المرور صحيحة و سيتم تنفيذ المطلوب", 64
        
        Application.ScreenUpdating = False
        Application.Calculation = xlManual
            If ws.Range("Q1") < 2 Then
                Exit Sub
            End If
            
            For Each sh In Sheets(Array("بيانات الطلبة", "إنجاز1", "تحريرى ف 1", "تحريرى ف 2", "أعمال السنة", "كشف الدور الثاني", "كشف ناجح"))
                lr = IIf(LastOccupiedRowNum(sh) = 7, 7, LastOccupiedRowNum(sh))
                lc = LastOccupiedColNum(sh)
                
                sh.Range("A8").Resize(lr + 7, lc).Clear
                sh.Range("A7").Resize(1, lc).AutoFill Destination:=sh.Range("A7").Resize(c, lc)
            Next sh
            
            Application.Goto ws.Range("A1")
        Application.Calculation = xlAutomatic
        Application.ScreenUpdating = True
        Unload Me
    Else
        MsgBox "عفواً كلمة المرور خاطئه و لن يتم تنفيذ المطلوب", vbExclamation
        TextBox1.Text = ""
        TextBox1.SetFocus
    End If
End Sub

Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    
    LastOccupiedRowNum = lng
End Function

Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng As Long
    
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    
    LastOccupiedColNum = lng
End Function

 

[ناصر سعيد]

ربنا يبارك في النافع يارب

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

ولكن المشكله الخاصه بالمسح مازالت موجوده

المســـح.rar

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

لم أفهم المشكلة للآن .. الكود يقوم بعملية المسح بداية من الصف رقم 8 وإلى آخر رقم صف .. ورقم الصف متغير من ورقة لأخرى ..

حاول توضح المشكلة بالصور لكي أفهم أين الخلل؟؟!

بعد الإطلاع على الملف .. وبشغل التخمين جرب السطر التالي .. ابحث عنه في الكود واستبدله بهذا السطر

sh.Range("A8").Resize(Rows.Count - 7, lc).Clear

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

[ناصر سعيد]

الاستاذ المحترم ياسر خليل

انا حفظت مرفقي السابق على الصفحه الموجود بها المشكله

السطر الجديد ادى الغرض

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

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

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

الحمد لله الذي بنعمته تتم الصالحات

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

وعلى رأي المثل اللي بيقول Come easy go easy >> 

[ناصر سعيد]

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