سؤال عن المصفوفات

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

هذا ترتيب تصاعدي وهو يعتبر أسرع أنواع الترتيب حيث يوجد أنواع مختلفة وهي :

الفرز الفقاعي Bubble Sort

الفرز بالإختيار Selection sorting

الفرز بالإدخال Sorting by Insertion

الفرز بطريقة شل (المتراكب أو الطبقي) Shell Sort

الفرز السريع Quick Sort

Sub QuickSort(Down, Up As Long, Num As Variant)

Dim M, K, X, Temp As Long

M = Down

K = Up

X = Num(Fix((Down + Up) / 2))

Do

Do While Num(M) < X: M = M + 1: Loop

Do While Num(K) > X: K = K - 1: Loop

If M <= K Then

Temp = Num(M): Num(M) = Num(K): Num(K) = Temp

M = M + 1

K = K - 1

End If

Loop Until M > K

If Down < K Then Call QuickSort(Down, CLng(K), Num)

If M < Up Then Call QuickSort(M, Up, Num)

End Sub

Sub Tests()

Dim Num As Variant

Dim Old As Variant

Num = Array(35, 50, 40, 30, 45, 80, 70, 90)

Dim K As Long

Old = Num

Call QuickSort(LBound(Num, 1), UBound(Num, 1), Num)

For K = LBound(Num, 1) To UBound(Num, 1)

MsgBox "Old Value " & Old(K) & Chr(13) & _

"New Value " & Num(K), , "Index " & K

Next K

End Sub

تحياتي

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

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

عموما مبدئيا يمكنك بعد الترتيب تصاعديا أن تعمل تكرار Loop يقوم بالتبديل بين أوائل السجلات مع أواخرها وهذا مثال لذلك :

Dim LB, UB, MB

LB = LBound(Num, 1)

UB = UBound(Num, 1)

MB = Fix((UB - LB) / 2)

For K = LB To MB

Temp = Num(K)

Num(K) = Num(UB - K)

Num(UB - K) = Temp

Next K

For K = LB To UB

MsgBox "Old Value " & Old(K) & Chr(13) & _

"New Value " & Num(K), , "Index " & K

Next K

تحياتي

كل إناء بالذي فيه ينضح

وإن أكرمت الكريم ملكته

نتيجة لتأخري فى بحث الموضوع

وضعت ملف به الأكواد التي لدي عسي أن يستفيد بها أحد

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

مع شكري لمن ساهم بالرد

إضغط

و السلام عليكم