Сортировать несколько строк слева направо

Question

У меня есть большой файл Excel, который я пытаюсь отсортировать слева направо, пытаясь получить vba подход к работе, но мой опыт слишком низкий.Удивительно, как трудно это сделать, что должно быть простой задачей.

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

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

На самом деле было немного сложнее, чем я ожидал, но вот код:

Я тоже позаимствовал, стандартный vba quicksort алгоритм, любезно предоставлено 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