السلام عليكم إخواني وأحبابي في الله





أقدم لكم كود يساعدكم على ترتيب البيانات داخل مصفوفة أحادية .. بعيداً عن الترتيب المستخدم في ورقة العمل بشكل مباشر ..


قم بوضع بعض البيانات في العمود الأول ثم نفذ الكود وستحصل على النتائج بعد ترتيب البيانات في العمود الثالث .. النتائج ستكون مرتبة تصاعدياً





إليكم الكود

Sub Test()
    Dim a()         As Variant
    Dim i           As Long
    Dim m           As Long

    m = Range("A" & Rows.Count).End(xlUp).Row
    ReDim a(1 To m)
    For i = 1 To m
        a(i) = Range("A" & i)
    Next i

    Call Quicksort(a(), LBound(a), UBound(a))
    
    Range("C1").Resize(UBound(a)).Value = Application.Transpose(a)
End Sub

Sub Quicksort(vArray As Variant, arrLbound As Long, arrUbound As Long)
    Dim pivotVal    As Variant
    Dim vSwap       As Variant
    Dim tmpLow      As Long
    Dim tmpHi       As Long
             
    tmpLow = arrLbound
    tmpHi = arrUbound
    pivotVal = vArray((arrLbound + arrUbound) 2)

    While (tmpLow <= tmpHi)
        While (vArray(tmpLow) < pivotVal And tmpLow < arrUbound)
            tmpLow = tmpLow + 1
        Wend

        While (pivotVal < vArray(tmpHi) And tmpHi > arrLbound)
            tmpHi = tmpHi - 1
        Wend

        If (tmpLow <= tmpHi) Then
            vSwap = vArray(tmpLow)
            vArray(tmpLow) = vArray(tmpHi)
            vArray(tmpHi) = vSwap
            tmpLow = tmpLow + 1
            tmpHi = tmpHi - 1
        End If
    Wend

    If (arrLbound < tmpHi) Then Quicksort vArray, arrLbound, tmpHi    'conquer
    If (tmpLow < arrUbound) Then Quicksort vArray, tmpLow, arrUbound    'conquer
End Sub

رابط الملف من هنا

أرجو أن يفيدكم إن شاء الله
تقبلوا وافر تقديري واحترامي