Vba 二維數組根據數組索引排序

Question

我正在嘗試根據 Thickness tableData(i,5) 對 tableData 數組進行排序。 我在 excel 中嘗試過，沒有問題，但是當我在 Solidworks 中嘗試時，我無法對它進行排序。 我在 excel 和 solidworks 中檢查了循環迭代有一些不同。 這是我的代碼；

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

Answer 1

我不在 SolidWorks 中工作...但是試試已知的 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

嘗試根據下一個測試 Sub 調用它（在 Excel 中）：

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

真的是極快！

構建數組並調用 function 僅使用它的前兩個參數（第二個是要對其排序的列）和最后一個參數以升序或降序排序。

作為標准 VBA（數組），我認為它也應該在 SolidWorks 中工作。

請在測試后發送一些反饋。