对数组进行排序并返回初始索引VBA

时间:2016-03-11 01:39:13

标签: arrays vba sorting indexing

所以这可能很容易,但我无法解决这个问题。我正在研究VBA。

我有以下数组:     temp=(9,9,9,8,8,4,4,3)

我希望对它进行排序,而不是返回

temp=(1,3,7,5,8,2,6,4)

我希望它返回值的索引,如

{{1}}。

感谢任何帮助。先感谢您!

2 个答案:

答案 0 :(得分:1)

试试这个:

Sub Tester()

    Dim arr, v, i, arr2()
    arr = Array(9, 4, 9, 3, 8, 4, 9, 8)
    ReDim arr2(LBound(arr) To UBound(arr))

    Debug.Print "Original", Join(arr, ",")

    For i = LBound(arr2) To UBound(arr2)
        arr2(i) = Application.Large(arr, i + 1)
    Next i
    Debug.Print "Sorted", Join(arr2, ",")

    For i = LBound(arr2) To UBound(arr2)
        v = Application.Match(arr2(i), arr, 0)
        arr2(i) = v 'save the position
        arr(v - 1) = vbNull 'remove the found value
    Next i
    Debug.Print "Positions", Join(arr2, ",")

End Sub

编辑:没有中间排序

Sub Tester2()

    Dim arr, v, i, arr2()

    arr = Array(9, 4, 9, 3, 8, 4, 9, 8)
    ReDim arr2(LBound(arr) To UBound(arr))

    For i = LBound(arr) To UBound(arr)
        v = Application.Match(Application.Large(arr, 1), arr, 0)
        arr(v - 1) = vbNull
        arr2(i) = v
    Next i
    Debug.Print "Positions", Join(arr2, ",")

End Sub

答案 1 :(得分:0)

这是另一种仅使用本机 VBA 函数的算法,即没有 Excel 函数(如 Application.Match 等),对于大型数组应该快得多。大约需要 5 秒来处理一个 ca 数组。 9000 个元素。它返回索引数组 sort_idx 以及排序值数组 arr_sorted。注意:这里的数组是 2D 的,具有任意数量的行和 1 列,取自工作表“1”上的 A 列。可以很容易地适应一维数组。

Sub cost_min()

    'Get data
    arr = Range(Sheets("1").Range("A1"), Sheets("1").Range("A1").End(xlDown)).Value2
    
    'Sort price curve & get indices
    Dim sort_idx(), arr_sorted()
    ReDim sort_idx(1 To UBound(arr)), arr_sorted(1 To UBound(arr))
    arr_2 = arr 'create copy to edit while sorting
    
    For i = 1 To UBound(arr)
    
        'Get max, record idx & value
        max_val = arr_2(1, 1)
        j = 1
        sort_idx(i) = j
        arr_sorted(i) = max_val
        
        For j = 1 To UBound(arr_2)
        
            If arr_2(j, 1) > max_val Then
                max_val = arr_2(j, 1)
                sort_idx(i) = j
                arr_sorted(i) = max_val
            End If
               
        Next j
        
        'Replace max found with null
        arr_2(sort_idx(i), 1) = vbNull
        
    Next i

 End Sub