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

论坛 期权论坛 编程之家     
选择匿名的用户   2021-5-24 05:16   30   0
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

分享到 :
0 人收藏
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

积分:3875789
帖子:775174
精华:0
期权论坛 期权论坛
发布
内容

下载期权论坛手机APP