Как отсортировать каждую строку индивидуально в массиве в VBA?

Question

Я построил массив со следующим кодом:

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):

Я хочу отсортировать значения для каждой строки (для каждого транспортного средства) в порядке убывания, но без расширения выбора.Поэтому я хочу взять каждую строку в виде массива и отсортировать ее.Я даже не уверен, возможно ли это.

Answer 1

Было бы просто использовать встроенную функцию сортировки и просто перебрать диапазон:

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

Answer 2

Диапазон сортировки

Код

Sub SortRowsDescending()

    Const cSheet As String = "Sheet1"   ' Source/Target Worksheet Name
    Const cRange As String = "B2:F21"   ' Source/Target Range Address
    Const cOrder As Long = 2            ' 1-xlAscending, 2-xlDescending
    Const cOrient As Long = 2           ' 1-xlColumns, 2-xlRows

    Dim rng As Range  ' Row Range
    Dim i As Long     ' Row Counter

    ' In Source/Target Range
    With ThisWorkbook.Worksheets(cSheet).Range(cRange)
        ' Loop through rows of Source/Target Range
        For i = 1 To .Rows.Count
            ' Create a reference to Row Range.
            Set rng = .Cells(i, 1).Resize(, .Columns.Count)
            ' Sort Row Range in descending order.
            rng.Sort Key1:=rng.Cells(1), Order1:=cOrder, Orientation:=cOrient
        Next
    End With

End Sub

Без констант Версия

Sub SortRowsDescendingNoConstants()

    Dim rng As Range  ' Row Range
    Dim i As Long     ' Row Counter

    ' In Source/Target Range
    With ThisWorkbook.Worksheets("Sheet1").Range("B2:F21")
        ' Loop through rows of Source/Target Range
        For i = 1 To .Rows.Count
            ' Create a reference to Row Range.
            Set rng = .Cells(i, 1).Resize(, .Columns.Count)
            ' Sort Row Range in descending order.
            rng.Sort Key1:=rng.Cells(1), Order1:=2, Orientation:=2
        Next
    End With

End Sub

Answer 3

Добавьте приведенный ниже код в модуль ...

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

... и затем выберите ваши данные без заголовков (как показано ниже) и запустите макрос.На снимке экрана показаны данные ПОСЛЕ того, как они отсортированы.

Я надеюсь, что это работает для вас.