Sort range without sorting it in a spreadsheet

后端 未结 3 758
温柔的废话
温柔的废话 2020-12-04 01:00

Question is about sorting data in VBA. Suppose I have a Range(\"A1:A10\") which I want to sort in ascending order. However, I do not want any changes in my spre

相关标签:
3条回答
  • 2020-12-04 01:07

    Here I am submitting slightly different sort routine.It sorts the 2nd column first then 1st column.

    Function BubbleSort(TempArray() As Variant, SortIndex As Long)
    
        Dim blnNoSwaps As Boolean
    
        Dim lngItem As Long
    
        Dim vntTemp(1 To 2) As Variant
    
        Dim lngCol As Long
    
        Do
    
            blnNoSwaps = True
    
            For lngItem = LBound(TempArray) To UBound(TempArray) - 1
    
                If TempArray(lngItem, SortIndex) > TempArray(lngItem + 1, SortIndex) Then
    
                    blnNoSwaps = False
    
                    For lngCol = 1 To 2
    
                        vntTemp(lngCol) = TempArray(lngItem, lngCol)
    
                        TempArray(lngItem, lngCol) = TempArray(lngItem + 1, lngCol)
    
                        TempArray(lngItem + 1, lngCol) = vntTemp(lngCol)
    
                    Next
    
                End If
    
            Next
    
        Loop While Not blnNoSwaps
    
    End Function
    
    
    
    Sub Test()
    
        Dim vntData() As Variant
    
        vntData = range("C3:D9")
    
        BubbleSort vntData, 2
    
        BubbleSort vntData, 1
    
        range("G3:H9") = vntData
    
    End Sub
    

    Results obtained from this routine are shown below.

    0 讨论(0)
  • 2020-12-04 01:12

    Here is a very simple little routine to sort a two-dimensional array such as a range:

    Option Base 1
    Option Explicit
    
    Function SortThisArray(aryToSort)
    
    Dim i As Long
    Dim j As Long
    Dim strTemp As String
    
    For i = LBound(aryToSort) To UBound(aryToSort) - 1
        For j = i + 1 To UBound(aryToSort)
            If aryToSort(i, 1) > aryToSort(j, 1) Then
                strTemp = aryToSort(i, 1)
                aryToSort(i, 1) = aryToSort(j, 1)
                aryToSort(j, 1) = strTemp
            End If
        Next j
    Next i
    
    SortThisArray = aryToSort
    
    End Function
    

    How to use this sort function:

    Sub tmpSO()
    
    Dim aryToSort As Variant
    
    aryToSort = Worksheets(1).Range("C3:D9").Value2    ' Input
    aryToSort = SortThisArray(aryToSort)               ' sort it
    Worksheets(1).Range("G3:H9").Value2 = aryToSort    ' Output
    
    End Sub
    

    Notes:

    1. The range sorted here is on Worksheet(1) in the Range("C3:D9") and the output is going on the same sheet into Range("G3:H9")
    2. The range will be sorted in ascending order.
    3. The range will be sorted based on the first column (here column C). If you wish to sort for another column then you just have to change all the aryToSort(i, 1) and aryToSort(j, 1) to which ever column you wish to sort. For example by column 2: aryToSort(i, 2) and aryToSort(j, 2).

    UPDATE:

    If you prefer to use the above as a function then this is also possible like this:

    Option Base 1
    Option Explicit
    
    Function SortThisArray(rngToSort As range)
    
    Dim i As Long
    Dim j As Long
    Dim strTemp As String
    Dim aryToSort As Variant
    
    aryToSort = rngToSort.Value2
    For i = LBound(aryToSort) To UBound(aryToSort) - 1
        For j = i + 1 To UBound(aryToSort)
            If aryToSort(i, 1) > aryToSort(j, 1) Then
                strTemp = aryToSort(i, 1)
                aryToSort(i, 1) = aryToSort(j, 1)
                aryToSort(j, 1) = strTemp
            End If
        Next j
    Next i
    
    SortThisArray = aryToSort
    
    End Function
    

    And this is how you would use the function:

    0 讨论(0)
  • 2020-12-04 01:16

    This is just a sample that you may adapt to your needs, it uses B11:B20 as NewRange:

    Sub SortElseWhere()
        Dim A As Range, NewRange As Range
    
        Set A = Range("A1:A10")
        Set NewRange = Range("B11:B20")
        A.Copy NewRange
        NewRange.Sort Key1:=NewRange(1, 1), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
    End Sub
    

    The original cells are not sorted, they are merely copied to another location which is sorted.

    EDIT#1:

    In this version, NewRange is not a range of cells, but an internal array:

    Sub SortElseWhere2()
        Dim A As Range, NewRange(1 To 10) As Variant
        Dim i As Long, strng As String
        i = 1
        Set A = Range("A1:A10")
        For Each aa In A
            NewRange(i) = aa
            i = i + 1
        Next aa
    
        Call aSort(NewRange)
    
        strng = Join(NewRange, " ")
        MsgBox strng
    
    End Sub
    
    Public Sub aSort(ByRef InOut)
    
        Dim i As Long, J As Long, Low As Long
        Dim Hi As Long, Temp As Variant
    
        Low = LBound(InOut)
        Hi = UBound(InOut)
    
        J = (Hi - Low + 1) \ 2
        Do While J > 0
            For i = Low To Hi - J
              If InOut(i) > InOut(i + J) Then
                Temp = InOut(i)
                InOut(i) = InOut(i + J)
                InOut(i + J) = Temp
              End If
            Next i
            For i = Hi - J To Low Step -1
              If InOut(i) > InOut(i + J) Then
                Temp = InOut(i)
                InOut(i) = InOut(i + J)
                InOut(i + J) = Temp
              End If
            Next i
            J = J \ 2
        Loop
    End Sub
    

    0 讨论(0)
提交回复
热议问题