ترتيب عشوائي

[blue sea]

السلام عليكم ..

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

random sort.xlsx

[lionheart]

The question is not clear but this is a code that randomize the data

Sub Test()
    Dim a
    a = GetRandomRows(Range("A1").CurrentRegion)
    Range("H1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Function GetRandomRows(ByVal rng As Range)
    Dim outputArray(), shuffledRows(), allRows(), selectedRows As Object, numRows As Long, numCols As Long, i As Long, j As Long
    numRows = rng.Rows.Count
    numCols = rng.Columns.Count
    ReDim outputArray(1 To numRows, 1 To numCols)
    Set selectedRows = CreateObject("Scripting.Dictionary")
    allRows = Application.Transpose(Evaluate("Row(" & rng.Rows(1).Address & ":" & rng.Rows(numRows).Address & ")"))
    shuffledRows = ShuffleArray(allRows)
    For i = 1 To numRows
        If Not selectedRows.Exists(shuffledRows(i)) Then
            selectedRows.Add shuffledRows(i), True
            For j = 1 To numCols
                outputArray(i, j) = rng(shuffledRows(i) - rng.Row + 1, j)
            Next j
        End If
    Next i
    GetRandomRows = outputArray
End Function

Function ShuffleArray(ByVal arr)
    Dim temp, i As Long, j As Long
    Randomize
    For i = UBound(arr) To LBound(arr) + 1 Step -1
        j = Int((i - LBound(arr) + 1) * Rnd + LBound(arr))
        temp = arr(j)
        arr(j) = arr(i)
        arr(i) = temp
    Next i
    ShuffleArray = arr
End Function

 

[blue sea]

اشكرك على الاجابة .. قصدي هل هناك طريقة للترتيب مثلا اضغط على ctrl مع تاشير الصفوف المطلوبة حسب الرغبة

[lionheart]

Still not clear for me