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

时间:2017-04-22 02:22:04

标签: arrays vba excel-vba sorting excel

要接收一个数据按字母顺序在Excel中排序的数组,我总是使用这样的东西:

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个排序标准,无限数。

问题在于需要时间。最糟糕的是当我在代码中操作时收到一个数组时,我必须首先将数组粘贴到工作表中,然后排序。有几十万行,需要几秒钟。

我使用QuickSort算法的修改来对数字进行排序,但我认为按字母顺序排序文本需要' StrComp'根据我的经验,这是相对耗时的。

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

1 个答案:

答案 0 :(得分:3)

您可以尝试使用ADODB库中的方法,只需对数据执行SELECT查询,其中ORDER BY数据中的文本列,无需编写自定义内容排序功能。

使用此方法可以扩展到任意数量的文本列,而无需担心自定义函数如何处理多列文本数据。

示例数据和输出:

enter image description here

上面的示例代码 - 请按照评论进行操作。

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

请注意以下事项:

  • 我在未保存的工作簿上出错 - 所以可能比你至少保存过一次工作簿更好
  • 需要针对输出范围调换已排序的数据 - 请参阅herehere