ترتيب أبجدى للعديد من الاوراق

[أبو سجده]

بسم الله الرحمن الرحيم

وبه نستعين

كل عام وانتم جميعا بخير وبكامل الصحة والسعادة

برجاء الاطلاع والافادة بحول الله تعالى بشأن المرفق التالى

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

من ورقة الاول حتى ورقة العاشر اعتمادا على اسماء اوراق المصنف

علما سيادتكم بأن الملف الاصلى يحتوى على اكثر من ثلاثون الف صف

لذا أرجو فضلا لو هناك حل باستخدام المصفوفات " لسرعتها وخفتها " أكون لكم من الشاكرين

تقبلوا وافر تقديرى واحترامى وجزاكم الله خيرا

ترتيب أبجدى للعديد من الاوراق.xlsb.rarFetching info...

تم تعديل يونيو 13, 2017 بواسطه ابو عبدالرحمن بيرم

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

السلام عليكم أخي العزيز أبو عبد الرحمن

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

يرجى مزيد من التفاصيل مع ذكر مثال ليتضح المقال

[بن علية حاجي]

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

أخي وحبيبي أبو عبد الرحمان تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال...

لست أدري إن كان هذا ما تريده ولكنها محاولة في الملف المرفق...

أخوك المحب بن علية حاجي

ترتيب أبجدي للعديد من الأوراق.rar

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

وعليكم السلام أخي الغالي بن عليه

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

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

For I = 5 To K
   J = Application.Match(Cells(K, "L").Value, Array("الاول", "الثانى", "الثالث", "الرابع", "الخامس", "السادس", "السابع", "الثامن", "التاسع", "العاشر"), 0)
   Cells(K, "M").Value = J
Next I

حيث في الحلقة التكرارية تم استخدام المتغير I ولكن لم يتم استخدامه داخل الحلقة التكرارية وهذا أمر حيرني .. أهناك حكمة من ذلك أم أن المتغير I يجب استخدامه بدلاً من المتغير K في كلا السطرين داخل الحلقة التكرارية

تقبل تحياتي

[أبو سجده]

اخى ونور عينى // بن عليه حاجى

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

 أشعر دائما بطمأنينة وراحة نفسية غيرعادية عندما تشاركنى موضوعاتى 

 وزاد إطمئنانى أكثر بمشاركة أخى وحبيبى فى الله // ياسر خليل " ابو البراء "

فبارك الله فيكم وفى أخى ابو البراء وبارك له فى البراء " اللهم أمين "

وتقبل الله منا ومنكم ومن الجميع صالح الاعمال

مشاركتى القادمة بحول الله تعالى لمزيد من التوضيح ولكن فاصل ونواصل

فقد حان الأن أذان المغرب بتوقيت القاهرة**** اتمنى لكم صوما مقبولا *** وعملا متقبلا 

تقبلوا وافر تقديرى واحترامى وجزاكم الله خيرا

تم تعديل يونيو 13, 2017 بواسطه ابو عبدالرحمن بيرم

[بن علية حاجي]

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

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

  في 13‏/6‏/2017 at 15:10, ياسر خليل أبو البراء said:

وعليكم السلام أخي الغالي بن عليه

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

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

For I = 5 To K
   J = Application.Match(Cells(K, "L").Value, Array("الاول", "الثانى", "الثالث", "الرابع", "الخامس", "السادس", "السابع", "الثامن", "التاسع", "العاشر"), 0)
   Cells(K, "M").Value = J
Next I

حيث في الحلقة التكرارية تم استخدام المتغير I ولكن لم يتم استخدامه داخل الحلقة التكرارية وهذا أمر حيرني .. أهناك حكمة من ذلك أم أن المتغير I يجب استخدامه بدلاً من المتغير K في كلا السطرين داخل الحلقة التكرارية

تقبل تحياتي

Expand  

أخي العزيز أبو البراء، شكرا على التنبيه وقد تم التصحيح في المرفق...

تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال...

أخوكم بن علية

ترتيب أبجدي للعديد من الأوراق.rar

[أبو سجده]

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

أخى وحبيبى فى الله // بن عليه حاجى

تقبل الله منا ومنكم صالح الاعمال وبارك فيكم وأعطاكم الله الصحة والعافية

اليكم اساتذتى الآجلاء التوضيح

الكود المبين بالمرفق التالى لنقل البيانات من الورقةdata  الى مالا نهاية من الاوراق بالمصنف إستنادا على العمود L باستخدام المصفوفات

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

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

 ليشمل ترتيب الاسماء أبجديا  بالعمود F من الورقة data لجميع أوراق العمل حسب المقتضيات استنادا على العمود L 

تقبلوا وافر تقديرى واحترامى وجزاكم الله خيرا

  Transfer data Based On Column.xlsb.rarFetching info...

تم تعديل يونيو 13, 2017 بواسطه ابو عبدالرحمن بيرم

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

تفضل أخي العزيز أبو عبد الرحمن كود يقوم بالترتيب لأوراق العمل من الفهرس رقم 2 إلى رقم 11 ...

Sub SortSheets()
    Dim i As Long
    Dim r As Long
    
    For i = 2 To 11
        With Worksheets(i)
            r = .Range("A7").CurrentRegion.Rows.Count + 5
            .Range("A7").CurrentRegion.Offset(2).Sort Key1:=.Range("F8:F" & r), Order1:=xlAscending, Header:=xlNo
        End With
    Next i
End Sub

 

[أبو سجده]

أخى وحبيبى فى الله // ابو البراء 

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

وبارك لكم فى نجلكم البراء " اللى انت مش قده واللا تقدر تكح ههههههههه "

أدرك ان إنشاء كود من بدايته أهون عليك بكثير من تعديل أكواد سابقة تمت على اكمل وجه

تم دمج الكودين معا بهذا الشكل

Sub Test1()
  Dim arrData, arrSheet, i As Long, j As Long, r As Long, rngHeader As Range
  ReDim arrSheet(1 To Worksheets.Count, 1 To 2)
  With Sheets("Data")
    Set rngHeader = Intersect(.Rows("1:7"), .Columns("A:L"))
    For i = 1 To Worksheets.Count
        arrSheet(i, 1) = Worksheets(i).Name   'Set sheet's name
        Set arrSheet(i, 2) = rngHeader        'Set header
    Next i
    arrData = .Range("A1:L" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    For i = 6 To UBound(arrData, 1)
        For j = 1 To UBound(arrSheet, 1)
            If arrSheet(j, 1) = arrData(i, 12) Then
               Set arrSheet(j, 2) = Union(arrSheet(j, 2), Intersect(.Rows(i), Columns("A:L")))  'For matched item, union this row with previous value
               Exit For
            End If
        Next j
    Next i
    For i = 1 To UBound(arrSheet, 1)
        If arrSheet(i, 2).Address <> rngHeader.Address Then
           arrSheet(i, 2).Copy Worksheets(arrSheet(i, 1)).Range("A1")  'Copy to corresponding sheet
        End If
    Next i
  End With
    For i = 2 To 11
        With Worksheets(i)
            r = .Range("A7").CurrentRegion.Rows.Count + 5
            .Range("A7").CurrentRegion.Offset(2).Sort Key1:=.Range("F8:F" & r), Order1:=xlAscending, Header:=xlNo
        End With
    Next i
End Sub

ولكنه أصبح مترنحا بين عمله بشكل جيد تاره وتارة أخرى رسالة Debag بهذا السطر من الكود

Set arrSheet(j, 2) = Union(arrSheet(j, 2), Intersect(.Rows(i), Columns("A:L")))

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

وبالتالى تصبح عملية الابجدة الا ما لا نهاية من الاوراق تلقائيا بدلا من تحديدها باوراق محددة بكود منفصل

أننى على يقين تام بالله اولا ثم بك بأنك لاتبخل  طالما أنه فى استطاعتك

تقبل وافر تقديرى واحترامى وجزاكم الله خيرا

تم تعديل يونيو 13, 2017 بواسطه ابو عبدالرحمن بيرم

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

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

أما بخصوص الخطأ لا أدري سببه ولكن يمكن تجنب الخطأ الوارد باستخدام جملة

On Error Resume Next

في بداية الكود

[أبو سجده]

اخى وحبيبى فى الله // ياسر خليل

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

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

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

 For i = 2 To 11

وجزاكم الله خيرا  تقبل الله منا ومنكم صالح الاعمال

تقبلوا وافر احترامى وجزاكم الله خيرا

 

تم تعديل يونيو 14, 2017 بواسطه ابو عبدالرحمن بيرم

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

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

إذا أردت جعل الحلقة التكرارية مرنة قم باستبدال الرقم 11 والذي يمثل رقم آخر فهرس بالمصنف بالجملة Worksheets.Count

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

[أبو سجده]

اخى وحبيبى فى الله // ابو البراء

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

جزاكم الله تعالى عنى خير الجزاء

وجزى أخى وحبيبى فى الله / بن عليه حاجى خير الجزاء

اسأل الله تعالى أن يمتعكم بالصحة والعافية وان يتقبل منا ومنكم صالح الاعمال

تقبلوا وافر تقديرى واحترامى وجزاكم الله خيرا