VBA排序二维数组(按字母顺序排列的文本值)-优化

问题描述

要接收具有Excel中按字母顺序排序的数据的数组，我总是使用类似这样的内容:

To receive an array with data sorted alphabetically in Excel, I always use something like this:

With ThisWorkbook.Worksheets("data")
    LastRow = .Cells.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    .Range("a2:b" & LastRow).Sort key1:=.Range("a1"), order1:=xlAscending
    vData = .Range("a2:b" & LastRow)
End With

我最多可以有3个排序标准，如果我使用不同的排序参数多次运行排序，则无穷大.

I can have up to 3 sorting criteria, an infinite number if I run sort multiple times with different sort parameters.

问题在于这需要时间.最糟糕的是，由于代码内的操作而收到数组时，我必须首先将数组粘贴到工作表中，然后进行排序.如果有数十万行，将需要几秒钟的时间.

The problem is that it takes time. The worst is when I receive an array as a result of operations within the code and I must first paste the array into worksheet, then sort. With a few hundred thousands of rows, it will take a few seconds.

我使用对QuickSort算法的修改来对数字进行排序，但我想按字母顺序对文本进行排序将需要'StrComp'，根据我的经验，这比较耗时.

I used my modifications of QuickSort algorithms to sort numbers, but I imagine that sorting text alphabetically would require 'StrComp', which from my experience is relatively time consuming.

您是否看过，或者您认为可以创建VBA二维数组字母排序算法(甚至可以是1个条件列)，其执行速度比Range.Sort(或粘贴大数组+排序)还要快?如果是，将如何比较字符串?

Have you seen or do you think it possible to create a VBA 2 dimensional array alphabetical sorting algorithm (can even be 1 criteria column), which will perform faster than Range.Sort (or pasting huge array + sort)? If yes, how would the strings be compared?

推荐答案

您可以尝试使用ADODB库中的方法，并且只需对数据进行SELECT查询，就可以在其中ORDER BY数据中的文本列进行查询.这消除了编写自定义排序功能的需要.

You can try using methods from the ADODB library and simply do a SELECT query on your data where you ORDER BY the text columns in the data which negates the need to write a custom sorting function.

使用这种方法，您可以缩放到任意数量的文本列，而不必担心自定义函数将如何处理文本数据的多列.

Using this approach will allow you to scale to any number of text columns without worrying how the custom function will deal with multiple columns of text data.

样本数据和输出:

上述示例代码-请遵循注释.

Sample code for above - please follow the comments.

Option Explicit

Sub SortDataBy2TextColumnsWithADO()

    Dim rngInput As Range
    Dim rngOutput As Range
    Dim strWbName As String
    Dim strConnection As String
    Dim objConnection As ADODB.Connection
    Dim strRangeReference As String
    Dim strSql As String
    Dim objRecordSet As ADODB.Recordset
    Dim varSortedData As Variant
    Dim wsf As WorksheetFunction

    ' set input range - includes header
    Set rngInput = ThisWorkbook.Worksheets("Sheet1").Range("A1:C19")

    ' set output range - just the first cell
    Set rngOutput = ThisWorkbook.Worksheets("Sheet1").Range("E1")

    ' copy the headers over
    rngOutput.Resize(1, 3).Value = rngInput.Rows(1).Value

    ' connection string for ACE OLEDB provider
    strWbName = ThisWorkbook.FullName
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & strWbName & ";" & _
        "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    ' make the connection to current workbook (better saved the workbook first)
    Set objConnection = New ADODB.Connection
    objConnection.Open strConnection

    ' get range reference as a string suitable for sql query
    strRangeReference = "[" & rngInput.Parent.Name & "$" & rngInput.Address(False, False) & "]"
    ' get the data ordered by text columns (1 and 2) and values (3)
    strSql = "select * from " & strRangeReference & " order by 1, 2, 3"

    ' populate the recordset
    Set objRecordSet = New ADODB.Recordset
    objRecordSet.Open strSql, objConnection

    ' get the sorted data to the variant
    varSortedData = objRecordSet.GetRows

    ' need to transpose the sorted data
    varSortedData = WorksheetFunction.Transpose(varSortedData)

    ' output the transposed sorted data to target range
    rngOutput.Offset(1, 0).Resize(UBound(varSortedData, 1), UBound(varSortedData, 2)).Value = varSortedData

    ' clean up
    objRecordSet.Close
    Set objRecordSet = Nothing
    objConnection.Close
    Set objConnection = Nothing

End Sub

请注意以下几点:

• 我在一个未保存的工作簿上出现错误-可能比您至少保存一次该工作簿更好
• 排序后的数据需要针对输出范围进行转置-请参见此处和此处

这篇关于VBA排序二维数组(按字母顺序排列的文本值)-优化的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！