vba二维数组排序及转为一维数组

Option Explicit

Sub test1()
    Dim sht
    Set sht = ActiveSheet
    Debug.Print GetDataXz(sht)
End Sub

Function GetDataXz(sht)

    Dim arr(1 To 8, 1 To 2), i, j, temp1, temp2, content
    '小组
    For i = 1 To 8
        arr(i, 1) = "'" & sht.Cells(i + 2, 1) & "'"
        arr(i, 2) = Round(sht.Cells(i + 2, "R") * 100, 2)
    Next
    
    '排序
    For i = 1 To 8
        For j = i + 1 To 8
            If arr(i, 2) < arr(j, 2) Then
                temp1 = arr(j, 1): temp2 = arr(j, 2)
                arr(j, 1) = arr(i, 1): arr(j, 2) = arr(i, 2)
                arr(i, 1) = temp1: arr(i, 2) = temp2
            End If
        Next
        arr(i, 2) = Format(arr(i, 2), "0.00")
    Next
        
    '转一维数组
    temp1 = Excel.WorksheetFunction.Transpose(Excel.WorksheetFunction.Index(arr, 0, 1))
    temp2 = Excel.WorksheetFunction.Transpose(Excel.WorksheetFunction.Index(arr, 0, 2))
    
    content = "    acsp_xz:[" & Join(temp1, ",") & "]," + vbCrLf
    content = content & "    acsp_xz_data:[" & Join(temp2, ",") & "]," + vbCrLf
        
    GetDataXz = content
End Function

 

你可能感兴趣的:(VBA)