منتدى المحاسبين المصريين

منتدى المحاسبين المصريين (https://www.aliahmedali.com/forum/index.php)
-   قسم تطبيقات الاكسل على فروع المحاسبة (https://www.aliahmedali.com/forum/forumdisplay.php?f=68)
-   -   ميكرو لترتيب (sort) عامود به ارقام بالاكسل (https://www.aliahmedali.com/forum/showthread.php?t=12574)

ahmedkamalali 02-03-2010 10:49 AM

ميكرو لترتيب (sort) عامود به ارقام بالاكسل
 
هذا الميكرو يستخدم لترتيب ارقام تنازليا بالاكسيل

كل مافى الامر ان تقوم بتحديد العمود المراد ترتيبه ثم تقوم بتشغيل الميكرو alt+f8

الكود

Sub bubble_sort() Dim sortingArray As Variant, i As Long, j As Long, temp As Variant

sortingArray = Selection.Value

For i = 1 To (UBound(sortingArray, 1) - 1)
For j = i To UBound(sortingArray, 1)
If Val(sortingArray(j, 1)) < Val(sortingArray(i, 1)) Then
temp = sortingArray(i, 1)
sortingArray(i, 1) = sortingArray(j, 1)
sortingArray(j, 1) = temp
End If
Next j
Next i

Selection.Value = sortingArray

End Sub

mesalamy 02-28-2014 08:45 PM

مشاركة: ميكرو لترتيب (sort) عامود به ارقام بالاكسل
 
جزاك الله كل خييييييييييييييييييييييييييير

mesalamy 02-28-2014 08:46 PM

مشاركة: ميكرو لترتيب (sort) عامود به ارقام بالاكسل
 
سبحانك اللهم وبحمدك ، أشهد أن لا إله إلا أنت أستغفرك وأتوب إليك

ياسر فتحى البنا 05-09-2015 09:58 PM

مشاركة: ميكرو لترتيب (sort) عامود به ارقام بالاكسل
 
تعديل الكود
Sub bubble_sort()
Dim sortingArray As Variant, i As Long, j As Long, temp As Variant

sortingArray = Selection.Value

For i = 1 To (UBound(sortingArray, 1) - 1)
For j = i To UBound(sortingArray, 1)
If Val(sortingArray(j, 1)) < Val(sortingArray(i, 1)) Then
temp = sortingArray(i, 1)
sortingArray(i, 1) = sortingArray(j, 1)
sortingArray(j, 1) = temp
End If
Next j
Next i

Selection.Value = sortingArray

End Sub


الساعة الآن 07:36 PM

Powered by Nile-Tech® Copyright ©2000 - 2025