تعديل كود فرز وترحيل القيود حسب الحروف الهجائية

[أبو محمد عباس]

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

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

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

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

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

البيانات المرحلة كمثال ولتقريب الفكرة المطلوبة قمت بتلوين تسلسل الحروف ا و ب و ت باللون الاصفر وقمت بتسلسل يدوي

كي يكون الترحيل بدون التسلسل وانا اقوم بوضع معادلة للتسلسل التلقائي او مع الكود بعد التعديل

بارك الله فيكم ورزقكم خير الدنيا وخير الاخرة

 

فرز وترحيل حسب الحروف الابجدية2007.rar

[الخالدي]

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

الفاضل / أبو محمد عباس

جرب الكود التالي

Sub AL_KHALEDI()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("بيانات الطلبة حسب الحروف")
Intersect(.Range("B5").Resize(9999, 11 * 28), .UsedRange).ClearContents
For Each C In Range(Sheets("بيانات الطلبة").[B4], Sheets("بيانات الطلبة").Cells(Rows.Count, 2).End(xlUp))
    T = Mid(Trim(C), 1, 1)
    If T = "ج" Then T = "ح" Else If T = "ح" Then T = "ج"
    M = Application.Match(T, [{"A","ب","ت","ث","ج","ح","خ","د","ذ","ر","ز","س","ش","ص","ض","ط","ظ","ع","غ","ف","ق","ك","ل","م","ن","ه","و","ي"}])
    If Not IsError(M) Then
        Lc = (M * 11) - 11 + 3
        Lr = Application.Max(5, .Cells(Rows.Count, Lc).End(xlUp).Row + 1)
        .Cells(Lr, Lc - 1).Value = Lr - 4
        .Cells(Lr, Lc).Resize(1, 8).Value = C.Resize(1, 8).Value
    Else: Er = Er + 1: End If
Next
End With
MsgBox "تم بحمد الله" & IIf(Er > 0, vbCr & Application.Rept("=", 30) & vbCr & "عدد الاسماء الخطا غير المرحلة" & vbCr & Er, "")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

في امان الله

[أبو محمد عباس]

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

الاستاذ والاخ الحبيب الخالدي جزاك الله خيرا

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

اعلى الله مقامكم في الدارين واعزكم واكرمكم

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

تقبل الله منكم صالح الاعمال وجعل عملكم هذا وجميع اعمالكم في ميزان حسناتكم

دمتم برعاية الله وحفظه

[حمادة عمر]

السلام عليكم

الاستاذ القدير / الخالدي

بارك الله فيك

دائما ما تغيب عنا وتعود للرد ويكون ما اجمل الرد

كود في منتهي الروعة والذكاء والاتقان

تقبل خالص تحياتي