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

输出将是…

Excel VBA阵列列排序

1 个答案: