我已經從作業表的范圍創建了一個 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 感謝您的回復！它有效，但我忽略了一些我必須編輯我的帖子的內容。希望你能弄清楚如何處理它。
Initially the A.[Groups] column in the Base table is blank and I am updating it in the recordset based on values from another column [segment]. So the sorting is coming all wrong!
Here is a main snapshot of the code for your inspection:
' 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
And here is the Unique Segments Table which is used to populate the Blank Groups column with the Assigned Groups based on the unique Segment names:
╔══════════════════════╤════════════════╗
║ 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 ║
╚══════════════════════╧════════════════╝
uj5u.com熱心網友回復：
將 Item 列添加到 2 個自定義訂單表，然后將它們連接到資料表并使用排序順序中的 Item 欄位。
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/364866.html