Vba 2d array sort acording to array index-CodePudding

I am trying to sort tableData array acording to Thickness tableData(i,5). I tried in excel there is no problem but when ı try in Solidworks ı couldn't sort it. I checked for loop iteration in excel and solidworks there are some difference. Here is my code;

Dim temp0 As Double, temp1 As String, temp2 As Double, temp3 As String, temp4 As Double, temp5 As Double
    For i = 0 To UBound(tableData, 1) - 1
        For j = i   1 To UBound(tableData, 1)
            If tableData(i, 5) < tableData(j, 5) Then ' kalınlık
                temp0 = tableData(j, 0)
                temp1 = tableData(j, 1)
                temp2 = tableData(j, 2)
                temp3 = tableData(j, 3)
                temp4 = tableData(j, 4)
                temp5 = tableData(j, 5)
                tableData(j, 0) = tableData(i, 0)
                tableData(j, 1) = tableData(i, 1)
                tableData(j, 2) = tableData(i, 2)
                tableData(j, 3) = tableData(i, 3)
                tableData(j, 4) = tableData(i, 4)
                tableData(j, 5) = tableData(i, 5)
                tableData(i, 0) = temp0
                tableData(i, 1) = temp1
                tableData(i, 2) = temp2
                tableData(i, 3) = temp3
                tableData(i, 4) = temp4
                tableData(i, 5) = temp5
            End If
        Next j
    Next i

CodePudding user response：

I do not work in SolidWorks... But try the known QuickSort function:

Extremely fast 2D array sorting:
'To be called as QuickSort2D arr, 3  to sort Ascending
'To be called as QuickSort2D arr, , , False to sort Descending
Private Sub QuickSort2D(SortArray, Col As Long, Optional l As Long = -1, Optional r As Long = -1, Optional bAscending As Boolean = True)
 Dim i As Long, j As Long, x, Y, k As Long

 If IsEmpty(SortArray) Then Exit Sub                        'the array is empty
 If InStr(TypeName(SortArray), "()") < 1 Then Exit Sub 'the array is not valid
 If l = -1 Then l = LBound(SortArray, 1)                    'to avoid an error when giving value to X
 If r = -1 Then r = UBound(SortArray, 1)                    'to avoid an error when giving value to X

 If l >= r Then Exit Sub                                    'no sorting needed, anymore

 i = l:  j = r
 x = SortArray((l   r) / 2, Col)                            'VBA automatically rounds (L   r)/2
                                                            'Choose an element of (aproximately) the middle of sorting column
 If bAscending Then
    While (i <= j)
        While (SortArray(i, Col) < x And i < r)
            i = i   1
        Wend
        While (x < SortArray(j, Col) And j > l)
            j = j - 1
        Wend
        If (i <= j) Then
            For k = LBound(SortArray, 2) To UBound(SortArray, 2)
                Y = SortArray(i, k)
                SortArray(i, k) = SortArray(j, k)
                SortArray(j, k) = Y
            Next k
        i = i   1: j = j - 1
        End If
    Wend
 Else
    While (i <= j)
        While (SortArray(i, Col) > x And i < r)
            i = i   1
        Wend
        While (x > SortArray(j, Col) And j > l)
            j = j - 1
        Wend
        If (i <= j) Then
            For k = LBound(SortArray, 2) To UBound(SortArray, 2)
                Y = SortArray(i, k)
                SortArray(i, k) = SortArray(j, k)
                SortArray(j, k) = Y
            Next k
            i = i   1: j = j - 1
        End If
    Wend
 End If
 If (l < j) Then Call QuickSort2D(SortArray, Col, l, j, bAscending)
 If (i < r) Then Call QuickSort2D(SortArray, Col, i, r, bAscending)
End Sub

Try calling it (in Excel) according to the next testing Sub:

SubTestQuickSort2D()
   Dim arr, arr1
   
   arr = Range("D2:F7").Value2
   arr1 = arr
   Debug.Print arr1(3.4, 1): 'Stop
   QuickSort2D arr, 1
End Sub

It is really extremely fast!

Build the array and call the function using only its first two parameters (he second is the column to sort on it) and the last one to sort Ascending or Descending.

Being standard VBA (arrays) it should work in SolidWorks, too, I think.

Please, send some feedback after testing it.