Сортировка столбцов в массиве Excel VBA

Question

Я все еще пытаюсь выяснить VBA, и у меня есть запрос на сортировку. У меня есть вызов функции MatrixSort (matrix), который принимает матрицу n1 x n2.Есть ли какая-либо функция сортировки, которая есть в VBA, которая позволяет мне сортировать матрицу по количеству, как показано ниже?

Ввод поля в Matrix Sort и получение вывода ниже:

Буду признателен, если кто-нибудь сможет рассказать мне об этом

Большое спасибо!

Редактировать: Спасибо pEH ​​за ваш код и логику.Я придумал функцию, основанную на вашей идее!Хотя код может быть неэффективным, я понял, что не существует простого способа подсчета CountA, поскольку функция будет заменять пустые ячейки на 0, поэтому мне пришлось вручную вводить "" и иметь счетчик, чтобы игнорировать его.

'Sorts the Matrix into Decending Count Order
'Key Idea: Calculate count in each column and saves into ArrCount
'Then use Max(ArrCount) to find the max row count
'Use Match to get the column number with the max row count, then input this to first column under MatrixOut
'Kill the count that was copied under ArrCount(iMax) = -1 so that the next maximum count can be found
'Thanks to pEH from Stackoverflow for helping out
Function MatrixSort(matrix)

    Dim MatrixTemp As Variant

    Dim max_row As Integer
    Dim max_col As Integer

    Dim p As Object
    Dim i As Integer
    Dim j As Integer
    Dim counter As Double 'Counts the number of filled range in matrix
    Dim iMax As Integer 'Stores the max count for sorting phase


    MatrixTemp = matrix

    'To preserve empty cells as empty instead of 0
    max_row = UBound(MatrixTemp, 1)
    max_col = UBound(MatrixTemp, 2)

    ReDim MatrixIn(1 To max_row, 1 To max_col)
    For i = 1 To UBound(MatrixTemp, 1)
        For j = 1 To UBound(MatrixTemp, 2)
            If MatrixTemp(i, j) = "" Then
                MatrixIn(i, j) = ""
            Else
                MatrixIn(i, j) = MatrixTemp(i, j)
            End If
        Next j
    Next i


    Set p = Application.WorksheetFunction

    'Counting of Each Columns
    ReDim ArrCount(1 To max_col) 'Counts filled rows in each column
    ReDim column_extract(1 To max_row) 'For CountA to work by counting each column individually

    For j = 1 To max_col
        For i = 1 To max_row
            If MatrixIn(i, j) <> "" Then
                counter = counter + 1
            End If
        Next i
        ArrCount(j) = counter 'Stores the total count
        counter = 0 'Resets the counter before another loop
    Next j

    'Creation of Final Output Matrix
    ReDim MatrixOut(1 To max_row, 1 To max_col) 'For the Final Output

    'Column Sort
    For j = 1 To max_col
        iMax = p.Match(p.Max(ArrCount), ArrCount, False)

        For i = 1 To max_row
            MatrixOut(i, j) = MatrixIn(i, iMax)
        Next i
        ArrCount(iMax) = -1
    Next j

    MatrixSort = MatrixOut

End Function

Answer 1

Представьте себе следующие данные:

Чтобы отсортировать их по количеству заполненных строк в каждом столбце, вам просто нужно рассчитать это количество .CountA(RngIn.Columns(iCol)) для каждого столбца и сохраните результаты в массив ArrCount.

Затем вы можете использовать .Max(ArrCount), чтобы найти максимальное число строк и.Match чтобы получить максимальный номер столбца.Это ваш первый столбец, поэтому напишите его по адресу RngOut.Теперь нам просто нужно убить счетчик, который уже был скопирован ArrCount(iMax) = -1, чтобы следующий максимум можно было найти и скопировать в следующий столбец назначения ... и так далее ...

Option Explicit

Public Sub MatrixSortColumnsByRowCount()
    'input range
    Dim RngIn As Range
    Set RngIn = Worksheets("Sheet1").Range("B2:F8")

    'output range
    Dim RngOut As Range
    Set RngOut = Worksheets("Sheet1").Range("B12:F18")

    'count filled rows in each column
    ReDim ArrCount(1 To RngIn.Columns.Count) As Long
    Dim iCol As Long
    For iCol = 1 To RngIn.Columns.Count
        ArrCount(iCol) = Application.WorksheetFunction.CountA(RngIn.Columns(iCol))
    Next iCol

    'sort columns
    Dim iMax As Long
    For iCol = 1 To RngIn.Columns.Count
        iMax = Application.WorksheetFunction.Match(Application.WorksheetFunction.Max(ArrCount), ArrCount, False)
        RngOut.Columns(iCol).Value = RngIn.Columns(iMax).Value
        ArrCount(iMax) = -1
    Next iCol
End Sub

Выходными данными тогда будет ...