如何在VBA中对数组中的每一行分别排序?

时间:2019-03-10 21:03:27

标签: excel vba

我用以下代码构造了一个数组:

For i = 1 To Vehiclenumber
For j = 1 To Vendornumber
Worksheets("Vendor").Cells(i + 8, j + 4) = Worksheets("Shipment").Cells(i 
+ 13, j + 2).Value * Worksheets("Vendor").Cells(j + 1, 6)
Next j
Next i

我有以下阵列(20辆汽车-5个供应商):

enter image description here

我想按降序对每行(每辆车)的值进行排序,但不扩展选择范围。所以我想将每一行作为一个数组并对它排序。我什至不确定是否可以。

2 个答案:

答案 0 :(得分:0)

将以下代码添加到模块中...

Public Sub SortColumnsDescending()
    Dim rngData As Range, lngRow As Long, lngCol As Long, arrData() As Double
    Dim lngIndex As Long, i As Long
    Dim x As Long, lngMin As Long, lngMax As Long, strTemp As String

    Set rngData = Selection

    With rngData
        For lngRow = 1 To rngData.Rows.Count
            lngIndex = -1

            For lngCol = 1 To rngData.Columns.Count
                lngIndex = lngIndex + 1

                ReDim Preserve arrData(lngIndex)
                arrData(lngIndex) = rngData.Cells(lngRow, lngCol)
            Next

            lngMin = LBound(arrData)
            lngMax = UBound(arrData)

            For i = lngMin To lngMax - 1
                For x = i + 1 To lngMax
                    If arrData(i) > arrData(x) Then
                        strTemp = arrData(i)
                        arrData(i) = arrData(x)
                        arrData(x) = strTemp
                    End If
                Next
            Next

            lngCol = 1

            For i = UBound(arrData) To 0 Step -1
                rngData.Cells(lngRow, lngCol) = arrData(i)
                lngCol = lngCol + 1
            Next
        Next
    End With
End Sub

...,然后选择不包含标题的数据(如下所示)并运行宏。屏幕截图显示了排序后的数据。

enter image description here

我希望对您有用。

答案 1 :(得分:0)

使用内置的“排序”功能很简单,只需遍历范围即可:

Function SortRowRangeData(dataRow As Range)
With dataRow.Worksheet.Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=dataRow, SortOn:=xlSortOnValues, Order:=xlDescending
    .SetRange dataRow
    .Header = xlNo
    .Orientation = xlLeftToRight

    .Apply
End With
End Function

Sub test()
    Dim rRow As Range
    'I hardcode for test below, but you can calc & put in your data range(no headers or Vehicle column)
    For Each rRow In Sheet1.Range("B2:F11").Rows
        SortRowRangeData rRow
    Next rRow
End Sub