对范围进行排序而不在电子表格中对其进行排序答案

【问题标题】：Sort range without sorting it in a spreadsheet对范围进行排序而不在电子表格中对其进行排序
【发布时间】：2016-09-11 08:50:54
【问题描述】：

问题是关于在 VBA 中对数据进行排序。假设我有一个Range("A1:A10")，我想按升序排序。但是，我不想在我的电子表格中进行任何更改（因此所有计算都是在 VBA 代码中进行的）。操作的输出应该是NewRange，其中所有数字都已排序。

有人对这个问题有想法吗？

【问题讨论】：

请在此处展示您为引起响应所做的努力。请注意，SO 不是我服务提供商的代码。它有助于整理成员遇到的具体问题。请搜索 excel vba 排序算法，然后努力自己做一些事情。在这里，专家们非常高兴和热衷于解决其成员在编码中面临的具体问题。
嗯，可以用公式来完成，可以通过手动复制粘贴然后排序来完成，或者您可以编写一个宏来为您完成。你的问题太宽泛了。
您可以使用任意数量的 VBA 排序例程，并通过 Internet 搜索轻松找到。或者您可以在 VBA 数组中进行所有计算；将结果写入 NewRange 并在工作表上对结果进行排序。如果您在开发的代码中遇到问题，请编辑您的原始问题以显示该问题并具体说明代码。另请阅读帮助以了解如何提出问题；以及如何提供示例。
感谢您的回答，但我之前已经完成了搜索。我发现了很多通过改变电子表格中的范围来实现排序的例子。但是，我没有找到根本不更改电子表格单元格的示例。这就是我在这里问这个问题的原因。

标签： vba excel sorting

【解决方案1】：

这是一个非常简单的小例程，用于对二维数组（例如范围）进行排序：

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

如何使用这个排序功能：

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

注意事项：

此处排序的范围位于Worksheet(1) 中的Range("C3:D9") 中，输出在同一张表中进入Range("G3:H9")
范围将按升序排序。
范围将根据第一列（此处为 C 列）进行排序。如果您希望对另一列进行排序，那么您只需将所有aryToSort(i, 1) 和aryToSort(j, 1) 更改为您希望排序的列。例如按第 2 列：aryToSort(i, 2) 和 aryToSort(j, 2)。

更新：

如果您更喜欢将上述内容用作函数，那么也可以这样：

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

这就是你将如何使用该功能：

【讨论】：

@Gary'sStudent 谢谢，但我猜你的简单方法仍然让你获得了更多的支持。
简单很好，但是........我喜欢你的代码，我真的很喜欢解释，我真的很喜欢内置的动态教程回答！！
@Gary'sStudent 谢谢，更新可能对这里有所帮助stackoverflow.com/questions/37243152/sortind-2d-range-using-udf
如果数据经常更改，UDF 方法显然是最好的。
@Ralph，感谢您的回答！虽然我的问题不是我的意思，但我认为这是一项很棒的工作，我们中的许多人有一天会发现它很有帮助。赞一个！

【解决方案2】：

这只是一个示例，您可以根据自己的需要进行调整，它使用 B11:B20 作为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

原始单元格未排序，它们只是复制到另一个已排序的位置。

编辑#1：

在这个版本中，NewRange 不是一个单元格区域，而是一个内部数组：

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

【讨论】：

谢谢！当 NewRange 值未粘贴到电子表格中而仅在其中排序时，您有解决方案吗？
@Alex 如果不在单元格中，我们会将NewRange 放在哪里？？
@Alex 查看我的 EDIT#1

【解决方案3】：

这里我提交的排序程序略有不同。它先对第二列排序，然后再对第一列排序。

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

从此例程获得的结果如下所示。

【讨论】：