从左到右对多行进行排序

Question

我有一个大的 excel 文件，我正在尝试按行从左到右排序，一直在尝试使用vba 工作方法，但我的经验太低了。令人惊讶的是，完成本应简单的任务竟如此困难。

我在另一篇文章中尝试过这段代码，但正在混合它们，只有第一行被安排。

Sub sortfile22()
   Dim keyrange As String
    Dim DataRange As String

    keyrange = "A1:T1"
    DataRange = "A1:T8"

    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(keyrange), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(DataRange)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

我的数据看起来像这样

1   2   3   4   5   6   7   8   9   10  11  12  13  14  15  16  17  18  19  20    
48  1   16  40  75  21  50  3   35  73  80  53  33  46  38  2   69  54  63  79    
54  27  62  56  79  67  71  75  28  35  78  66  60  65  5   47  31  38  68  21    
56  77  43  9   64  80  72  16  17  46  10  22  63  34  41  8   53  60  6   79

Answer 1

您需要单独对每一行进行排序。因此，通过DataRange 逐行循环并自行对每个DataRow 进行排序。

Option Explicit

Public Sub SortRowWise()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim DataRange As Range
    Set DataRange = ws.Range("A1").CurrentRegion

    Dim DataRow As Range
    For Each DataRow In DataRange.Rows 'loop through all rows of the data
        With ws.Sort
            .SortFields.Clear
            .SortFields.Add Key:=DataRow, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Rng:=DataRow
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
    Next DataRow
End Sub

所以这个输入数据……

... 将排序为：

Answer 2

实际上比我预期的要难一些，但代码如下：

我也借了，标准的vbaquicksort算法， 礼貌 wellsr.com, 但您可以随意使用任何其他排序算法，只需确保更改这行代码：

Quicksort sortrow, LBound(sortrow), UBound(sortrow) ' calling QuickSort

然后代码按如下方式执行：

Private Sub main()
    
    Dim i As Integer, lc As Long, lr as Long, j As Integer
    Dim arr As Variant
    

    lr = Cells(Rows.Count, 1).End(xlUp).Row ' finds the last row
    lc = Cells(1, Columns.Count).End(xlToLeft).Column ' finds the last i-th column
    arr = Range(Cells(1, 1), Cells(lr, lc)).Value2
             
    Dim sortrow() As Integer ' sorting each row separately
    
    For i = LBound(arr, 1) To UBound(arr, 1) ' for every row
        For j = LBound(arr, 2) To UBound(arr, 2) ' add
            ReDim Preserve sortrow(1 To j)
            sortrow(j) = arr(i, j) ' adding arr elements to SortRow
        Next j
        
        Quicksort sortrow, LBound(sortrow), UBound(sortrow) ' calling QuickSort
        For j = LBound(sortrow) To UBound(sortrow)
            Cells(i, j) = sortrow(j) ' print the sorted results
        Next j
    Next i
End Sub

按预期工作：

Answer 3

稍微修改的数组方法

只是为了艺术，我修改了@Rawrplus 的有效且快速的解决方案，将三个循环减少到一个并避免永久重新调整。

Option Explicit                                             ' declaration head of code module

Private Sub Main()
With Sheet1                                                 ' << reference sheet via code name, e.g. Sheet1
  ' [1] do some statistics over data range
    Dim i&, lr&, lc&                                        ' declare datatype Long
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row               ' find last row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column     ' find last column
  ' [2] assign data to array
    Dim arr(), sortrow()                                    ' declare Variant arrays
    arr = .Range(.Cells(1, 1), .Cells(lr, lc)).Value2       ' assign range data to 1-based 2-dim datafield array
  ' [3] sort row data and write them back to sheet
    For i = LBound(arr, 1) To UBound(arr, 1)                ' loop through row data
        sortrow = Application.Index(arr, i, 0)              ' assign current row data to 1-dim sortrow array
        Quicksort sortrow, LBound(sortrow), UBound(sortrow) ' calling QuickSort
        .Cells(i, 1).Resize(1, UBound(sortrow)) = sortrow   ' write sorted row data back to sheet
    Next i
End With
End Sub