根据自定义顺序对 ADO 记录集字段进行排序
Sort ADO Recordset Fields based on Custom Order
我已经从工作表的范围创建了一个 ADO 记录集，如下所示，我想自定义排序 Groups 字段，然后是 Type 字段。排序顺序应该是 Groups 列的值应按照另一个工作表范围列 Status1 中给出的自定义顺序排列，并且 Type 列的值应排列在另一个工作表范围列 Status2 中给出的自定义顺序，例如:
+====+===========+================+
| | A | B |
+====+===========+================+
| 1 | Type | Groups |
+----+-----------+----------------+
| 2 | Restage 2 | Target Group 6 |
+----+-----------+----------------+
| 3 | Restage 3 | Target Group 6 |
+----+-----------+----------------+
| 4 | Restage 1 | Target Group 6 |
+----+-----------+----------------+
| 5 | Current | Target Group 6 |
+----+-----------+----------------+
| 6 | Restage 1 | Target Group 4 |
+----+-----------+----------------+
| 7 | Current | Target Group 4 |
+----+-----------+----------------+
| 8 | Restage 2 | Target Group 4 |
+----+-----------+----------------+
| 9 | Restage 3 | Target Group 4 |
+----+-----------+----------------+
| 10 | Restage 3 | Target Group 2 |
+----+-----------+----------------+
| 11 | Restage 1 | Target Group 2 |
+----+-----------+----------------+
| 12 | Restage 2 | Target Group 2 |
+----+-----------+----------------+
| 13 | Current | Target Group 2 |
+----+-----------+----------------+
| 14 | Current | Non Buyers |
+----+-----------+----------------+
| 15 | Restage 1 | Non Buyers |
+----+-----------+----------------+
| 16 | Restage 3 | Non Buyers |
+----+-----------+----------------+
| 17 | Restage 2 | Non Buyers |
+----+-----------+----------------+
| 18 | Current | GP |
+----+-----------+----------------+
| 19 | Restage 3 | GP |
+----+-----------+----------------+
| 20 | Restage 2 | GP |
+----+-----------+----------------+
| 21 | Restage 1 | GP |
+----+-----------+----------------+
| 22 | Restage 2 | Buyers |
+----+-----------+----------------+
| 23 | Restage 1 | Buyers |
+----+-----------+----------------+
| 24 | Current | Buyers |
+----+-----------+----------------+
| 25 | Restage 3 | Buyers |
+====+===========+================+
喜欢这个：
+====+===========+================+
| | A | B |
+====+===========+================+
| 1 | Type | Groups |
+----+-----------+----------------+
| 2 | Current | GP |
+----+-----------+----------------+
| 3 | Restage 1 | GP |
+----+-----------+----------------+
| 4 | Restage 2 | GP |
+----+-----------+----------------+
| 5 | Restage 3 | GP |
+----+-----------+----------------+
| 6 | Current | Buyers |
+----+-----------+----------------+
| 7 | Restage 1 | Buyers |
+----+-----------+----------------+
| 8 | Restage 2 | Buyers |
+----+-----------+----------------+
| 9 | Restage 3 | Buyers |
+----+-----------+----------------+
| 10 | Current | Non Buyers |
+----+-----------+----------------+
| 11 | Restage 1 | Non Buyers |
+----+-----------+----------------+
| 12 | Restage 2 | Non Buyers |
+----+-----------+----------------+
| 13 | Restage 3 | Non Buyers |
+----+-----------+----------------+
| 14 | Current | Target Group 2 |
+----+-----------+----------------+
| 15 | Restage 1 | Target Group 2 |
+----+-----------+----------------+
| 16 | Restage 2 | Target Group 2 |
+----+-----------+----------------+
| 17 | Restage 3 | Target Group 2 |
+----+-----------+----------------+
| 18 | Current | Target Group 4 |
+----+-----------+----------------+
| 19 | Restage 1 | Target Group 4 |
+----+-----------+----------------+
| 20 | Restage 2 | Target Group 4 |
+----+-----------+----------------+
| 21 | Restage 3 | Target Group 4 |
+----+-----------+----------------+
| 22 | Current | Target Group 6 |
+----+-----------+----------------+
| 23 | Restage 1 | Target Group 6 |
+----+-----------+----------------+
| 24 | Restage 2 | Target Group 6 |
+----+-----------+----------------+
| 25 | Restage 3 | Target Group 6 |
+====+===========+================+
两列的自定义顺序将从 2 个单列 Excel 范围中选取（可以是
转换为数组）如下图：
状态 1:
+===+================+
| | A |
+===+================+
| 1 | GP |
+---+----------------+
| 2 | Buyers |
+---+----------------+
| 3 | Non Buyers |
+---+----------------+
| 4 | Target Group 1 |
+---+----------------+
| 5 | Target Group 2 |
+---+----------------+
| 6 | Target Group 3 |
+---+----------------+
| 7 | Target Group 4 |
+---+----------------+
| 8 | Target Group 5 |
+---+----------------+
| 9 | Target Group 6 |
+===+================+
和：
状态 2:
+====+============+
| | A |
+====+============+
| 1 | Current |
+----+------------+
| 2 | Restage 1 |
+----+------------+
| 3 | Restage 2 |
+----+------------+
| 4 | Restage 3 |
+----+------------+
| 5 | Restage 4 |
+----+------------+
| 6 | Restage 5 |
+----+------------+
| 7 | Restage 6 |
+----+------------+
| 8 | Restage 7 |
+----+------------+
| 9 | Restage 8 |
+----+------------+
| 10 | Restage 9 |
+----+------------+
| 11 | Restage 10 |
+====+============+
例如：
Set oRS = CreateObject("ADODB.Recordset")
....
With oRS
.Sort = "Groups <customorder>,Types <customorder>"
End With
有谁知道如何使用 Recordset 对象进行自定义顺序排序？
编辑：
@CDP1802 感谢您的回复！它有效，但我忽略了一些我必须编辑我的 post 的东西。希望你能想出如何处理它。
最初，Base table 中的 A.[Groups] 列是空白的，我正在根据另一列 [segment] 的值在记录集中更新它。所以排序全错了！
这是供您检查的代码的主要快照：
' Grab `Groups` Filters from Study Details
With shtStudyDetails
xLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
If xLastRow <= 18 Then Exit Sub
' first check if `Assign` column has been filled in too
Set xRg = .Range(.Cells(19, "B"), .Cells(xLastRow, "B"))
If WorksheetFunction.CountA(xRg.Offset(0, 1).Cells) < WorksheetFunction.CountA(xRg.Cells) Then Exit Sub
Set sRg = xRg.Resize(xRg.Rows.Count, 2)
vArr = sRg.Value2
' Get Segment values excluding `Assign : Not Assigned`
xStr = ""
For j = 1 To UBound(vArr)
If Not InStr(1, vArr(j, 2), "Not Assigned", vbTextCompare) > 0 Then xStr = xStr & "_" & j
Next j
If xStr = "" Then
vIncludeArr = vArr
Else
vIncludeArr = Application.Index(vArr, Application.Transpose(Split(Mid(xStr, 2), "_")), Application.Transpose([row(1:2)]))
End If
If UBound(vIncludeArr) <= 1 And vIncludeArr(UBound(vIncludeArr), 1) = vbEmpty Then Exit Sub
Set KeyValues1 = shtStudyDetails.Cells.Range("E45:F55") ' range1 table on whose values order to sort Groups
Set KeyValues2 = shtStudyDetails.Cells.Range("G45:H106") ' range2 table on whose values order to sort Type
End With
With shtSummaryOfData
xLastColumn = .Range("1:1").Cells(.Columns.Count).End(xlToLeft).Column
If xLastColumn = 1 Then Exit Sub
Set xRng = .Range(.Cells(1, 1), .Cells(1, xLastColumn))
' clear Summary of data sheet
xLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
If xLastRow < 2 Then Exit Sub
.Range(.Cells(2, 1), .Cells(xLastRow, xLastColumn)).ClearContents
strSQL = ""
xStr = ""
strSQL = "SELECT "
For Each xCell In xRng
With xCell
xStr = xCell.Value2
If InStr(1, xStr, " ", vbTextCompare) > 0 Then xStr = WorksheetFunction.Substitute(xStr, " ", " ")
If InStr(1, xStr, ".", vbTextCompare) > 0 Then xStr = WorksheetFunction.Substitute(xStr, ".", "#")
End With
strSQL = strSQL & "A.[" & xStr & "],"
Next xCell
strSQL = Left(strSQL, Len(strSQL) - 1)
strSQL = strSQL & " FROM (([" & shtPasteData.Name & "$" & xRg.Address(False, False, xlA1) & "] AS A "
strSQL = strSQL & " LEFT JOIN [" & shtStudyDetails.Name & "$" & KeyValues1.Address(False, False, xlA1) & "] AS G ON G.[Groups] = A.[Groups])"
strSQL = strSQL & " LEFT JOIN [" & shtStudyDetails.Name & "$" & KeyValues2.Address(False, False, xlA1) & "] AS T ON T.[Type] = A.[Type])"
' Join Segments in `vIncludeArr` that did not have Assign:Not Assigned
With Application
xStr = "'" & Join(.Transpose(.Index(vIncludeArr, 0, 1)), "','") & "'"
End With
strSQL = strSQL & " WHERE A.[segment] IN (" & xStr & ")"
strSQL = strSQL & " ORDER BY G.ITEM, T.ITEM "
End With
Set oCon = CreateObject("ADODB.Connection")
Set oRec = CreateObject("ADODB.Recordset")
With oCon
.Mode = adModeReadWrite
.CursorLocation = adUseClient
.Open Join$(Array("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & _
sPath$ & ";Extended Properties=""Excel 12.0 Xml; HDR=YES;IMEX=0"";"), vbNullString)
End With
With oRec
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
Set .ActiveConnection = oCon
.Open (strSQL)
Set .ActiveConnection = Nothing
' updating Groups column based on values in `vIncludeArr`
Do While Not .EOF
For j = 1 To UBound(vIncludeArr, 1)
If .Fields("segment").Value = vIncludeArr(j, 1) Then .Fields("Groups").Value = vIncludeArr(j, 2)
Next j
.MoveNext
Loop
.MoveLast
.MoveFirst
' .Sort = .Fields("Groups").Name & " ASC," & .Fields("Type").Name & " ASC"
.MoveLast
.MoveFirst
shtSummaryOfData.Range("A2").CopyFromRecordset .DataSource
.Close
End With
这里是唯一细分 Table，用于根据唯一细分名称使用分配的组填充空白 Groups 列：
╔══════════════════════╤════════════════╗
║ Segments │ Assign Groups ║
╠══════════════════════╪════════════════╣
║ ALL RESPONSES │ GP ║
╟──────────────────────┼────────────────╢
║ Some xx Target Group │ Target Group 1 ║
╟──────────────────────┼────────────────╢
║ Some Buyer1 │ Buyers ║
╟──────────────────────┼────────────────╢
║ Some Non-Buyer1 │ Target Group 2 ║
╟──────────────────────┼────────────────╢
║ Some yy Target Group │ Target Group 3 ║
╟──────────────────────┼────────────────╢
║ Some zz Target Group │ Target Group 5 ║
╚══════════════════════╧════════════════╝
向 2 个自定义顺序 table 添加项目列，然后将它们加入数据 table 并在排序顺序中使用项目字段。
Option Explicit
Sub test()
Dim con As ADODB.Connection, sCon As String
sCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties='Excel 12.0 Macro;HDR=YES';"
Set con = New ADODB.Connection
With con
.ConnectionString = sCon
.Open
End With
Const SQL = " SELECT A.Type, A.Groups FROM (([Sheet1$] AS A" & _
" LEFT JOIN [Sheet2$] AS T ON T.Type = A.Type)" & _
" LEFT JOIN [Sheet3$] AS G ON G.Groups = A.Groups)" & _
" ORDER BY G.Item, T.Item"
With Sheet4
.Cells.Clear
.Range("A1").CopyFromRecordset con.Execute(SQL)
End With
End Sub
我已经从工作表的范围创建了一个 ADO 记录集，如下所示，我想自定义排序 Groups 字段，然后是 Type 字段。排序顺序应该是 Groups 列的值应按照另一个工作表范围列 Status1 中给出的自定义顺序排列，并且 Type 列的值应排列在另一个工作表范围列 Status2 中给出的自定义顺序，例如:
+====+===========+================+
| | A | B |
+====+===========+================+
| 1 | Type | Groups |
+----+-----------+----------------+
| 2 | Restage 2 | Target Group 6 |
+----+-----------+----------------+
| 3 | Restage 3 | Target Group 6 |
+----+-----------+----------------+
| 4 | Restage 1 | Target Group 6 |
+----+-----------+----------------+
| 5 | Current | Target Group 6 |
+----+-----------+----------------+
| 6 | Restage 1 | Target Group 4 |
+----+-----------+----------------+
| 7 | Current | Target Group 4 |
+----+-----------+----------------+
| 8 | Restage 2 | Target Group 4 |
+----+-----------+----------------+
| 9 | Restage 3 | Target Group 4 |
+----+-----------+----------------+
| 10 | Restage 3 | Target Group 2 |
+----+-----------+----------------+
| 11 | Restage 1 | Target Group 2 |
+----+-----------+----------------+
| 12 | Restage 2 | Target Group 2 |
+----+-----------+----------------+
| 13 | Current | Target Group 2 |
+----+-----------+----------------+
| 14 | Current | Non Buyers |
+----+-----------+----------------+
| 15 | Restage 1 | Non Buyers |
+----+-----------+----------------+
| 16 | Restage 3 | Non Buyers |
+----+-----------+----------------+
| 17 | Restage 2 | Non Buyers |
+----+-----------+----------------+
| 18 | Current | GP |
+----+-----------+----------------+
| 19 | Restage 3 | GP |
+----+-----------+----------------+
| 20 | Restage 2 | GP |
+----+-----------+----------------+
| 21 | Restage 1 | GP |
+----+-----------+----------------+
| 22 | Restage 2 | Buyers |
+----+-----------+----------------+
| 23 | Restage 1 | Buyers |
+----+-----------+----------------+
| 24 | Current | Buyers |
+----+-----------+----------------+
| 25 | Restage 3 | Buyers |
+====+===========+================+
喜欢这个：
+====+===========+================+
| | A | B |
+====+===========+================+
| 1 | Type | Groups |
+----+-----------+----------------+
| 2 | Current | GP |
+----+-----------+----------------+
| 3 | Restage 1 | GP |
+----+-----------+----------------+
| 4 | Restage 2 | GP |
+----+-----------+----------------+
| 5 | Restage 3 | GP |
+----+-----------+----------------+
| 6 | Current | Buyers |
+----+-----------+----------------+
| 7 | Restage 1 | Buyers |
+----+-----------+----------------+
| 8 | Restage 2 | Buyers |
+----+-----------+----------------+
| 9 | Restage 3 | Buyers |
+----+-----------+----------------+
| 10 | Current | Non Buyers |
+----+-----------+----------------+
| 11 | Restage 1 | Non Buyers |
+----+-----------+----------------+
| 12 | Restage 2 | Non Buyers |
+----+-----------+----------------+
| 13 | Restage 3 | Non Buyers |
+----+-----------+----------------+
| 14 | Current | Target Group 2 |
+----+-----------+----------------+
| 15 | Restage 1 | Target Group 2 |
+----+-----------+----------------+
| 16 | Restage 2 | Target Group 2 |
+----+-----------+----------------+
| 17 | Restage 3 | Target Group 2 |
+----+-----------+----------------+
| 18 | Current | Target Group 4 |
+----+-----------+----------------+
| 19 | Restage 1 | Target Group 4 |
+----+-----------+----------------+
| 20 | Restage 2 | Target Group 4 |
+----+-----------+----------------+
| 21 | Restage 3 | Target Group 4 |
+----+-----------+----------------+
| 22 | Current | Target Group 6 |
+----+-----------+----------------+
| 23 | Restage 1 | Target Group 6 |
+----+-----------+----------------+
| 24 | Restage 2 | Target Group 6 |
+----+-----------+----------------+
| 25 | Restage 3 | Target Group 6 |
+====+===========+================+
两列的自定义顺序将从 2 个单列 Excel 范围中选取（可以是 转换为数组）如下图：
状态 1:
+===+================+
| | A |
+===+================+
| 1 | GP |
+---+----------------+
| 2 | Buyers |
+---+----------------+
| 3 | Non Buyers |
+---+----------------+
| 4 | Target Group 1 |
+---+----------------+
| 5 | Target Group 2 |
+---+----------------+
| 6 | Target Group 3 |
+---+----------------+
| 7 | Target Group 4 |
+---+----------------+
| 8 | Target Group 5 |
+---+----------------+
| 9 | Target Group 6 |
+===+================+
和：
状态 2:
+====+============+
| | A |
+====+============+
| 1 | Current |
+----+------------+
| 2 | Restage 1 |
+----+------------+
| 3 | Restage 2 |
+----+------------+
| 4 | Restage 3 |
+----+------------+
| 5 | Restage 4 |
+----+------------+
| 6 | Restage 5 |
+----+------------+
| 7 | Restage 6 |
+----+------------+
| 8 | Restage 7 |
+----+------------+
| 9 | Restage 8 |
+----+------------+
| 10 | Restage 9 |
+----+------------+
| 11 | Restage 10 |
+====+============+
例如：
Set oRS = CreateObject("ADODB.Recordset")
....
With oRS
.Sort = "Groups <customorder>,Types <customorder>"
End With
有谁知道如何使用 Recordset 对象进行自定义顺序排序？
编辑：
@CDP1802 感谢您的回复！它有效，但我忽略了一些我必须编辑我的 post 的东西。希望你能想出如何处理它。
最初，Base table 中的 A.[Groups] 列是空白的，我正在根据另一列 [segment] 的值在记录集中更新它。所以排序全错了！
这是供您检查的代码的主要快照：
' Grab `Groups` Filters from Study Details
With shtStudyDetails
xLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
If xLastRow <= 18 Then Exit Sub
' first check if `Assign` column has been filled in too
Set xRg = .Range(.Cells(19, "B"), .Cells(xLastRow, "B"))
If WorksheetFunction.CountA(xRg.Offset(0, 1).Cells) < WorksheetFunction.CountA(xRg.Cells) Then Exit Sub
Set sRg = xRg.Resize(xRg.Rows.Count, 2)
vArr = sRg.Value2
' Get Segment values excluding `Assign : Not Assigned`
xStr = ""
For j = 1 To UBound(vArr)
If Not InStr(1, vArr(j, 2), "Not Assigned", vbTextCompare) > 0 Then xStr = xStr & "_" & j
Next j
If xStr = "" Then
vIncludeArr = vArr
Else
vIncludeArr = Application.Index(vArr, Application.Transpose(Split(Mid(xStr, 2), "_")), Application.Transpose([row(1:2)]))
End If
If UBound(vIncludeArr) <= 1 And vIncludeArr(UBound(vIncludeArr), 1) = vbEmpty Then Exit Sub
Set KeyValues1 = shtStudyDetails.Cells.Range("E45:F55") ' range1 table on whose values order to sort Groups
Set KeyValues2 = shtStudyDetails.Cells.Range("G45:H106") ' range2 table on whose values order to sort Type
End With
With shtSummaryOfData
xLastColumn = .Range("1:1").Cells(.Columns.Count).End(xlToLeft).Column
If xLastColumn = 1 Then Exit Sub
Set xRng = .Range(.Cells(1, 1), .Cells(1, xLastColumn))
' clear Summary of data sheet
xLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
If xLastRow < 2 Then Exit Sub
.Range(.Cells(2, 1), .Cells(xLastRow, xLastColumn)).ClearContents
strSQL = ""
xStr = ""
strSQL = "SELECT "
For Each xCell In xRng
With xCell
xStr = xCell.Value2
If InStr(1, xStr, " ", vbTextCompare) > 0 Then xStr = WorksheetFunction.Substitute(xStr, " ", " ")
If InStr(1, xStr, ".", vbTextCompare) > 0 Then xStr = WorksheetFunction.Substitute(xStr, ".", "#")
End With
strSQL = strSQL & "A.[" & xStr & "],"
Next xCell
strSQL = Left(strSQL, Len(strSQL) - 1)
strSQL = strSQL & " FROM (([" & shtPasteData.Name & "$" & xRg.Address(False, False, xlA1) & "] AS A "
strSQL = strSQL & " LEFT JOIN [" & shtStudyDetails.Name & "$" & KeyValues1.Address(False, False, xlA1) & "] AS G ON G.[Groups] = A.[Groups])"
strSQL = strSQL & " LEFT JOIN [" & shtStudyDetails.Name & "$" & KeyValues2.Address(False, False, xlA1) & "] AS T ON T.[Type] = A.[Type])"
' Join Segments in `vIncludeArr` that did not have Assign:Not Assigned
With Application
xStr = "'" & Join(.Transpose(.Index(vIncludeArr, 0, 1)), "','") & "'"
End With
strSQL = strSQL & " WHERE A.[segment] IN (" & xStr & ")"
strSQL = strSQL & " ORDER BY G.ITEM, T.ITEM "
End With
Set oCon = CreateObject("ADODB.Connection")
Set oRec = CreateObject("ADODB.Recordset")
With oCon
.Mode = adModeReadWrite
.CursorLocation = adUseClient
.Open Join$(Array("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & _
sPath$ & ";Extended Properties=""Excel 12.0 Xml; HDR=YES;IMEX=0"";"), vbNullString)
End With
With oRec
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
Set .ActiveConnection = oCon
.Open (strSQL)
Set .ActiveConnection = Nothing
' updating Groups column based on values in `vIncludeArr`
Do While Not .EOF
For j = 1 To UBound(vIncludeArr, 1)
If .Fields("segment").Value = vIncludeArr(j, 1) Then .Fields("Groups").Value = vIncludeArr(j, 2)
Next j
.MoveNext
Loop
.MoveLast
.MoveFirst
' .Sort = .Fields("Groups").Name & " ASC," & .Fields("Type").Name & " ASC"
.MoveLast
.MoveFirst
shtSummaryOfData.Range("A2").CopyFromRecordset .DataSource
.Close
End With
这里是唯一细分 Table，用于根据唯一细分名称使用分配的组填充空白 Groups 列：
╔══════════════════════╤════════════════╗
║ Segments │ Assign Groups ║
╠══════════════════════╪════════════════╣
║ ALL RESPONSES │ GP ║
╟──────────────────────┼────────────────╢
║ Some xx Target Group │ Target Group 1 ║
╟──────────────────────┼────────────────╢
║ Some Buyer1 │ Buyers ║
╟──────────────────────┼────────────────╢
║ Some Non-Buyer1 │ Target Group 2 ║
╟──────────────────────┼────────────────╢
║ Some yy Target Group │ Target Group 3 ║
╟──────────────────────┼────────────────╢
║ Some zz Target Group │ Target Group 5 ║
╚══════════════════════╧════════════════╝
向 2 个自定义顺序 table 添加项目列，然后将它们加入数据 table 并在排序顺序中使用项目字段。
Option Explicit
Sub test()
Dim con As ADODB.Connection, sCon As String
sCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties='Excel 12.0 Macro;HDR=YES';"
Set con = New ADODB.Connection
With con
.ConnectionString = sCon
.Open
End With
Const SQL = " SELECT A.Type, A.Groups FROM (([Sheet1$] AS A" & _
" LEFT JOIN [Sheet2$] AS T ON T.Type = A.Type)" & _
" LEFT JOIN [Sheet3$] AS G ON G.Groups = A.Groups)" & _
" ORDER BY G.Item, T.Item"
With Sheet4
.Cells.Clear
.Range("A1").CopyFromRecordset con.Execute(SQL)
End With
End Sub