محمد زيدان2024 قام بنشر يونيو 27 مشاركة قام بنشر يونيو 27 المطلوب عمل كود ترتيب ابجدي للاسماء وعمل كود ترتيب تنازلي للمجموع @محمد هشام. فرز.xlsb رابط هذا التعليق شارك More sharing options...
Saleh Ahmed Rabie قام بنشر يونيو 28 مشاركة قام بنشر يونيو 28 12 ساعات مضت, محمد زيدان2024 said: المطلوب عمل كود ترتيب ابجدي للاسماء وعمل كود ترتيب تنازلي للمجموع @محمد هشام. فرز.xlsb 571.92 kB · 3 downloads **كود VBA لترتيب الأسماء أبجديًا** Sub SortNamesAlphabetically() Dim rng As Range Dim lastRow As Long ' تحديد نطاق البيانات Set rng = Range("A1:A100") ' تعديل النطاق حسب الحاجة ' الحصول على آخر صف في النطاق lastRow = rng.Rows.Count ' فرز النطاق أبجديًا rng.Sort Key1:=rng.Columns(1), Order1:=xlAscending, Header:=xlYes End Sub **كود VBA لترتيب المجموع تنازليًا** Sub SortSumDescending() Dim rng As Range Dim lastRow As Long ' تحديد نطاق البيانات Set rng = Range("A1:B100") ' تعديل النطاق حسب الحاجة ' الحصول على آخر صف في النطاق lastRow = rng.Rows.Count ' فرز النطاق تنازليًا حسب المجموع في العمود B rng.Sort Key1:=rng.Columns(2), Order1:=xlDescending, Header:=xlYes End Sub **ملاحظات:** * تأكد من تعديل نطاقات البيانات في أكواد VBA لتتوافق مع نطاق بياناتك الفعلي. * يمكنك استخدام هذه الأكواد لترتيب البيانات في أي نطاق من ورقة العمل. * إذا كنت ترغب في فرز البيانات حسب معايير متعددة، يمكنك استخدام طريقة `Sort` مع معلمات `Key2` و`Order2` و`Key3` و`Order3` وما إلى ذلك. رابط هذا التعليق شارك More sharing options...
محمد زيدان2024 قام بنشر يونيو 28 الكاتب مشاركة قام بنشر يونيو 28 ارجو الحل @محمد هشام. رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 28 مشاركة قام بنشر يونيو 28 طلبك غير واضح بالنسبة لي ربما لم استطع استوعابه يمكنك شرح المطلوب بشكل اكثر وضوحا عند الاجابة على هده الاسئلة اخي @محمد زيدان2024 ادا قمنا بترتيب كل عمود على حدى هدا سياثر على صحة البيانات المجاورة من تاريخ الميلاد وحتى عمود السنة في حالة قمنا بفرز عمود الاسم ابجديا مع تحديد جميع البيانات هدا من شانه ان ياثر على ترتيب عمود المجموع وعند محاولة ترتيبه هو الاخر سيأثر على بياناتك سوف يصبح مجموع محمد مثلا يقابل اسم جرجس 1 رابط هذا التعليق شارك More sharing options...
محمد زيدان2024 قام بنشر يونيو 28 الكاتب مشاركة قام بنشر يونيو 28 (معدل) منذ ساعه, محمد هشام. said: طلبك غير واضح بالنسبة لي ربما لم استطع استوعابه يمكنك شرح المطلوب بشكل اكثر وضوحا عند الاجابة على هده الاسئلة اخي @محمد زيدان2024 ادا قمنا بترتيب كل عمود على حدى هدا سياثر على صحة البيانات المجاورة من تاريخ الميلاد وحتى عمود السنة في حالة قمنا بفرز عمود الاسم ابجديا مع تحديد جميع البيانات هدا من شانه ان ياثر على ترتيب عمود المجموع وعند محاولة ترتيبه هو الاخر سيأثر على بياناتك سوف يصبح مجموع محمد مثلا يقابل اسم جرجس فعلا المطلوب كود ترتيب ابجدي للعمود c ( الاسماء) مع تحديد جميع البيانات وكود اخر بترتيب تنازلى للمجموع للعمود i مع مع تحديد جميع البيانات كل كود منفصل عن الاخر واكيد لو رتبنا ابجدي البيانات هتختلف بما فيه المجموع ولو رتبنا تنازلى للمجموع البيانات هتختلف بما فيها الاسم تم تعديل يونيو 28 بواسطه محمد زيدان2024 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 28 مشاركة قام بنشر يونيو 28 (معدل) تمام اخي محمد تم تعديل يونيو 28 بواسطه محمد هشام. 1 رابط هذا التعليق شارك More sharing options...
محمد زيدان2024 قام بنشر يونيو 28 الكاتب مشاركة قام بنشر يونيو 28 تمام اخى بس المجموع حضرتك عملته تصاعدى والمطلوب تنازلى من الاكبر للاصغر رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 28 مشاركة قام بنشر يونيو 28 تفضل اخي @محمد زيدان2024 تم تعديل الاكواد لتتناسب مع طلبك Option Compare Text Public Property Get f() As Worksheet: Set f = Worksheets("12 د بنون") End Property '================29/06/2024 by:MOHAMEED HICHAM www.officena.net "منتدى الاكسيل" ' '=========================================================================================== Sub TriTotal_Descending_Order() 'ترتيب تنازلي Dim a() Dim r As Range a = f.Range("C11:J" & f.[C65000].End(xlUp).Row).Value Set r = f.Range("C11:J" & f.[C65000].End(xlUp).Row) ' تحديد نطاق معين 'a = [C11:J38].Value: Set r = [C11:J38] ' <<=======عمود المجموع======== Call Quick(a(), LBound(a), _ UBound(a), 7, False): r.Value2 = a End Sub '**********فرز سريع************* Sub Quick(a(), gauc, droi, Cnt, ordre) Total = a((gauc + droi) \ 2, Cnt) Rng = gauc: d = droi Do If ordre Then Do While a(Rng, Cnt) < Total: Rng = Rng + 1: Loop Do While Total < a(d, Cnt): d = d - 1: Loop Else Do While a(Rng, Cnt) > Total: Rng = Rng + 1: Loop Do While Total > a(d, Cnt): d = d - 1: Loop End If If Rng <= d Then For i = LBound(a, 2) To UBound(a, 2) temp = a(Rng, i): a(Rng, i) = a(d, i): a(d, i) = temp Next i Rng = Rng + 1: d = d - 1 End If Loop While Rng <= d If Rng < droi Then Call Quick(a, Rng, droi, Cnt, ordre) If gauc < d Then Call Quick(a, gauc, d, Cnt, ordre) End Sub '************************************ Sub Tri_Colmun_Name() 'ترتيب ابجدي Dim clé() As String, index() As Long, Rng As Range a = f.Range("C11:J" & f.[C65000].End(xlUp).Row).Value Dim b(): Set Rng = f.[C11] ReDim b(LBound(a) To UBound(a), LBound(a, 2) To UBound(a, 2)) Set rCrit = CreateObject("System.Collections.Sortedlist") For i = LBound(a) To UBound(a) rCrit.Add a(i, 1) & i, i Next i For tmp = LBound(a) To UBound(a) For arr = LBound(a, 2) To UBound(a, 2) b(tmp, arr) = a(rCrit.GetByIndex(tmp - 1), arr) Next arr Next tmp Rng.Resize(UBound(b), UBound(b, 2)).Value2 = b End Sub '************************************* Sub Tri_Total_Colmun() 'ترتيب تصاعدي Dim clé() As String, index() As Long, Rng As Range a = f.Range("C11:J" & f.[C65000].End(xlUp).Row).Value Dim b(): Set Rng = f.[C11] ReDim b(LBound(a) To UBound(a), LBound(a, 2) To UBound(a, 2)) Set rCrit = CreateObject("System.Collections.Sortedlist") For i = LBound(a) To UBound(a) rCrit.Add a(i, 7) & i, i Next i For tmp = LBound(a) To UBound(a) For arr = LBound(a, 2) To UBound(a, 2) b(tmp, arr) = a(rCrit.GetByIndex(tmp - 1), arr) Next arr Next tmp Rng.Resize(UBound(b), UBound(b, 2)).Value2 = b End Sub فرز V3.xlsb 3 رابط هذا التعليق شارك More sharing options...
mahmoud nasr alhasany قام بنشر يونيو 28 مشاركة قام بنشر يونيو 28 احسنت وبارك الله فيك ا/ محمد هشام 1 رابط هذا التعليق شارك More sharing options...
محمد زيدان2024 قام بنشر يونيو 28 الكاتب مشاركة قام بنشر يونيو 28 جهد مشكور بس الاكود لازم ادوس عليها مرتين علشان تشتغل رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 28 مشاركة قام بنشر يونيو 28 (معدل) 45 دقائق مضت, محمد زيدان2024 said: جهد مشكور بس الاكود لازم ادوس عليها مرتين علشان تشتغل انت لم تنتبه انه لديك نفس قيمة المجموع للاسماء 🤔🤔🤔 فارس محمد عبد الرازق اسماعيل 676 عمار سيد عبد الرازق اسماعيل 676 الكود يقوم بتحديثها جرب تغيير الرقم وسوف تلاحظ الفرق تم تعديل يونيو 28 بواسطه محمد هشام. 1 رابط هذا التعليق شارك More sharing options...
محمد زيدان2024 قام بنشر يونيو 28 الكاتب مشاركة قام بنشر يونيو 28 عند الضغط على الورقة اخري والرجوع لنفس الورقة الرتيب الابجدي لايعمل ولا التصاعدي ويعمل التنازلي رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 28 مشاركة قام بنشر يونيو 28 (معدل) غريب صراحة لا اعلم لمادا لانني جربت الملف عندي ويشتغل بشكل جيد و بدون ادنى مشكلة وللتأكد قمت بتجربته على جهاز اخر انظر الرابط التالي 👇 https://streamable.com/3m40n4 رغم انني متأكد من صحة الاكواد وبما ان كود التنازلي يعمل جرب هدا للتصاعدي و الترتيب الابجدي ووافينا بالنتيجة Sub Tri_Names_Ordre() 'ترتيب ابجدي Dim a() Dim r As Range a = f.Range("C11:J" & f.[C65000].End(xlUp).Row).Value Set r = f.Range("C11:J" & f.[C65000].End(xlUp).Row) ' <<=======عمود الاسم======== Call Quick(a(), LBound(a), _ UBound(a), 1, True): r.Value2 = a End Sub '************* Sub Tri_Ordre_croissant() 'ترتيب تصاعدي Dim a() Dim r As Range a = f.Range("C11:J" & f.[C65000].End(xlUp).Row).Value Set r = f.Range("C11:J" & f.[C65000].End(xlUp).Row) ' <<=======عمود المجموع======== Call Quick(a(), LBound(a), _ UBound(a), 7, True): r.Value2 = a End Sub فرز V4.xlsb تم تعديل يونيو 29 بواسطه محمد هشام. 1 رابط هذا التعليق شارك More sharing options...
محمد زيدان2024 قام بنشر يونيو 29 الكاتب مشاركة قام بنشر يونيو 29 (معدل) تمام شكرا اخي بارك الله فيك بس لو امكن نغير ده تتنازلي لو امكن Sub Tri_Total_column() 'ترتيب تنازلي Dim clé() As String, index() As Long, Rng As Range a = [C11:J38].Value: Set Rng = [c11] Dim b() ReDim b(LBound(a) To UBound(a), LBound(a, 2) To UBound(a, 2)) Set rCrit = CreateObject("System.Collections.Sortedlist") For i = LBound(a) To UBound(a) rCrit.Add a(i, 7) & i, i Next i For tmp = LBound(a) To UBound(a) For arr = LBound(a, 2) To UBound(a, 2) b(tmp, arr) = a(rCrit.GetByIndex(tmp - 1), arr) Next arr Next tmp Rng.Resize(UBound(b), UBound(b, 2)).Value2 = b End Sub تم تعديل يونيو 29 بواسطه محمد زيدان2024 رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر يونيو 29 أفضل إجابة مشاركة قام بنشر يونيو 29 (معدل) بطريقة اخرى Option Compare Text Public Property Get F() As Worksheet: Set F = Worksheets("12 د بنون") End Property Public Property Get lr() As Long: lr = F.Columns("C:J").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row End Property Sub Sort_Names() 'ترتيب ابجدي Dim OneRng As Range Set OneRng = F.Range("C11:J" & lr) With OneRng .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlNo End With End Sub '*********** Sub Sort_TOTAL() 'ترتيب تنازلي Dim OneRng As Range Set OneRng = F.Range("C11:J" & lr) With OneRng .Sort Key1:=.Columns(7), Order1:=xlDescending, Header:=xlNo End With End Sub '********* Sub Sort_TOTAL2() 'ترتيب تصاعدي Dim OneRng As Range Set OneRng = F.Range("C11:J" & lr) With OneRng .Sort Key1:=.Columns(7), Order1:=xlAscending, Header:=xlNo End With End Sub فرز Final.xlsb تم تعديل يونيو 29 بواسطه محمد هشام. 3 رابط هذا التعليق شارك More sharing options...
محمد زيدان2024 قام بنشر يونيو 29 الكاتب مشاركة قام بنشر يونيو 29 شكرا بارك الله فيك فعلا انتا موسوعة اكسل @محمد هشام. 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.