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

EN

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