可以 Excel 排序与其默认 U.S 不同。字符集？
Can Excel Sort Differently Than Its Default U.S. Character Set?
我的问题基本上与 THIS ONE 相反（它有一个基于数据库的解决方案，我不能在这里使用）。
我使用 SAP，它以这种方式对字符进行排序：
0-9, A-Z, _
但我正在将数据下载到 Excel 并根据正确的 SAP 字符集排序顺序处理范围。
如何强制 Excel 按照与 SAP 相同的方式排序，下划线排在最后。
在 Excel 的排序功能中尝试使用单个字符的自定义排序列表后，Excel still/always 排序如下：
_, 0-9, A-Z
有没有办法让 Excel 像 SAP 一样排序？如果需要，我可以执行 Excel 宏。
或者，如果有人知道如何让本机 SAP 表在 SAP 界面中像 Excel 一样排序，那么也可以解决这个问题。
编辑：此解决方案基于自定义订单列表的自动计算，但如果有太多不同的值，它就不起作用。在我的例子中，它使用了一个可能总共 35.000 个字符的自定义订单列表，但对于原始海报的大列表却失败了。
以下代码按 ASCII 值对请求的列进行排序，具有这种顺序：
0-9, A-Z, _, a-z
我猜小写字母与大写字母分开不是问题，因为 SAP 主要以大写字母定义值。如果需要，可以轻松调整代码以获得自定义订单 0-9, Aa-Zz, _（通过使用 UCase 和 worksheet.Sort.MatchCase = False）。
此顺序不同于基于语言环境的内置 Excel 排序顺序。例如，在英语中，它将是：
_, 0-9, Aa-Zz
原理是使用"custom order list"，其值取自Excel列，使其唯一，并使用QuickSort3算法排序（子程序MedianThreeQuickSort1 由 Ellis Dee 在 http://www.vbforums.com/showthread.php?473677-VB6-Sorting-algorithms-(sort-array-sorting-arrays)) 提供。
关于 Excel 通过自定义列表排序的性能说明（我不是在谈论 QuickSort3）：
- 自定义订单列表中的不同值越多，性能越低。具有 20 个不同值的 4,000 行会立即排序，但具有 4,000 个不同值的 4,000 行需要 8 秒才能排序！
- 对于相同数量的不同值，如果要排序的行很多，性能不会有太大变化。具有 6 个不同值的 300,000 行排序需要 3 秒。
Sub SortByAsciiValue()
With ActiveSheet.Sort
.SortFields.Clear
.SetRange Range("A:A").CurrentRegion
.SortFields.Add Key:=Columns("A"), Order:=xlAscending, _
CustomOrder:=DistinctValuesInAsciiOrder(iRange:=Columns("A"), Header:=True)
.Header = xlYes
.Apply
End With
End Sub
Function DistinctValuesInAsciiOrder(iRange As Range, Header As Boolean) As String
Dim oCell As Range
Dim oColl As New Collection
On Error Resume Next
For Each oCell In iRange.Cells
Err.Clear
If Header = True And oCell.Row = iRange.Row Then
ElseIf oCell.Row > iRange.Worksheet.UsedRange.Rows.Count Then
Exit For
Else
dummy = oColl.Item(oCell.Text)
If Err.Number <> 0 Then
oColl.Add oCell.Text, oCell.Text
totalLength = totalLength + Len(oCell.Text) + 1
End If
End If
Next
On Error GoTo 0
If oColl.Count = 0 Then
Exit Function
End If
Dim values() As String
ReDim values(1)
ReDim values(oColl.Count - 1 + LBound(values))
For i = 1 To oColl.Count
values(i - 1 + LBound(values)) = oColl(i)
Next
Call MedianThreeQuickSort1(values)
' String concatenation is complex just for better performance (allocate space once)
DistinctValuesInAsciiOrder = Space(totalLength - 1)
Mid(DistinctValuesInAsciiOrder, 1, Len(values(LBound(values)))) = values(LBound(values))
off = 1 + Len(values(LBound(values)))
For i = LBound(values) + 1 To UBound(values)
Mid(DistinctValuesInAsciiOrder, off, 1 + Len(values(i))) = "," & values(i)
off = off + 1 + Len(values(i))
Next
End Function
以下解决方案的原理是插入一个新列，其中的单元格有一个公式，该公式计算要排序的列的每个单元格的"sortable code"。
如果您对这个新列进行排序，行将按 ASCII 顺序排序 (0-9, A-Z, _)。
它应该能够处理任意数量的行。在我的笔记本电脑上，计算 130.000 行的单元格需要 1 分钟。有两个 VBA 函数，一个用于 ASCII，一个用于 EBCDIC。定义其他字符集非常容易。
步骤：
- 在您的 Excel 工作簿中创建一个模块并将代码放在下面。
- 关闭 VB 编辑器，否则 it will run slowly。
- 在要排序的工作表中，为要排序的每一列插入一列，例如假设要对 A 列进行排序，在单元格
B1 插入公式 =SortableCodeASCII(A1) 并对 B 列的所有单元格（直到 A 列的最后一行）执行相同的操作。
- 确保公式计算结束（在我的笔记本电脑上130.000行需要1分钟），否则如果排序，顺序将不正确，因为公式尚未计算。您会在 Excel window 底部的状态栏上看到进度指示器（百分比）。如果看不到，请按 Ctrl+Alt+F9.
- 按 B 列排序。A 列中的值应根据 ASCII 顺序排序 (
0-9, A-Z, _)
祝你好运！
Option Compare Text 'to make true "a" = "A", "_" < "0", etc.
Option Base 0 'to start arrays at index 0 (LBound(array) = 0)
Dim SortableCharactersASCII() As String
Dim SortableCharactersEBCDIC() As String
Dim SortableCharactersTEST() As String
Sub ResetSortableCode()
'Run this subroutine if you change anything in the code of this module
'to regenerate the arrays SortableCharacters*
Erase SortableCharactersASCII
Erase SortableCharactersEBCDIC
Erase SortableCharactersTEST
Call SortableCodeASCII("")
Call SortableCodeEBCDIC("")
Call SortableCodeTEST("")
End Sub
Function SortableCodeASCII(text As String)
If (Not Not SortableCharactersASCII) = 0 Then
SortableCharactersASCII = getSortableCharacters( _
orderedCharacters:=" !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}" & ChrW(126) & ChrW(127))
End If
SortableCodeASCII = getSortableCode(text, SortableCharactersASCII)
End Function
Function SortableCodeEBCDIC(text As String)
If (Not Not SortableCharactersEBCDIC) = 0 Then
SortableCharactersEBCDIC = getSortableCharacters( _
orderedCharacters:=" ¢.<(+|&!$*);-/¦,%_>?`:#@'=""abcdefghi±jklmnopqr~stuvwxyz^[]{ABCDEFGHI}JKLMNOPQR\STUVWXYZ0123456789")
End If
SortableCodeEBCDIC = getSortableCode(text, SortableCharactersEBCDIC)
End Function
Function SortableCodeTEST(text As String)
If (Not Not SortableCharactersTEST) = 0 Then
SortableCharactersTEST = getSortableCharacters( _
orderedCharacters:="ABCDEF 0123456789_")
End If
SortableCodeTEST = getSortableCode(text, SortableCharactersTEST)
End Function
Function getSortableCharacters(orderedCharacters As String) As String()
'Each character X is assigned another character Y so that sort by character Y will
'sort character X in the desired order.
maxAscW = 0
For i = 1 To Len(orderedCharacters)
If AscW(Mid(orderedCharacters, i, 1)) > maxAscW Then
maxAscW = AscW(Mid(orderedCharacters, i, 1))
End If
Next
Dim aTemp() As String
ReDim aTemp(maxAscW)
j = 0
For i = 1 To Len(orderedCharacters)
'Was a character with same "sort weight" previously processed ("a" = "A")
For i2 = 1 To i - 1
If AscW(Mid(orderedCharacters, i, 1)) <> AscW(Mid(orderedCharacters, i2, 1)) _
And Mid(orderedCharacters, i, 1) = Mid(orderedCharacters, i2, 1) Then
'If two distinct characters are equal when case is ignored (e.g. "a" and "A")
'(this is possible only because directive "Option Compare Text" is defined at top of module)
'then only one should be used (either "a" or "A" but not both), so that the Excel sorting
'does not vary depending on sorting option "Ignore case".
Exit For
End If
Next
If i2 = i Then
'NO
aTemp(AscW(Mid(orderedCharacters, i, 1))) = Format(j, "000")
j = j + 1
Else
'YES "a" has same weight as "A"
aTemp(AscW(Mid(orderedCharacters, i, 1))) = aTemp(AscW(Mid(orderedCharacters, i2, 1)))
End If
Next
'Last character is for any character of input text which is not in orderedCharacters
aTemp(maxAscW) = Format(j, "000")
getSortableCharacters = aTemp
End Function
Function getOrderedCharactersCurrentLocale(numOfChars As Integer) As String
'Build a string of characters, ordered according to the LOCALE order.
' (NB: to order by LOCALE, the directive "Option Compare Text" must be at the beginning of the module)
'Before sorting, the placed characters are: ChrW(0), ChrW(1), ..., ChrW(numOfChars-1), ChrW(numOfChars).
'Note that some characters are not used: for those characters which have the same sort weight
' like "a" and "A", only the first one is kept.
'For debug, you may define constdebug=48 so that to use "printable" characters in sOrder:
' ChrW(48) ("0"), ChrW(49) ("1"), ..., ChrW(numOfChars+47), ChrW(numOfChars+48).
sOrder = ""
constdebug = 0 'Use 48 to help debugging (ChrW(48) = "0")
i = 34
Do Until Len(sOrder) = numOfChars
Select Case constdebug + i
Case 0, 7, 14, 15: i = i + 1
End Select
sCharacter = ChrW(constdebug + i)
'Search order of character in current locale
iOrder = 0
For j = 1 To Len(sOrder)
If AscW(sCharacter) <> AscW(Mid(sOrder, j, 1)) And sCharacter = Mid(sOrder, j, 1) Then
'If two distinct characters are equal when case is ignored (e.g. "a" and "A")
'("a" = "A" can be true only because directive "Option Compare Text" is defined at top of module)
'then only one should be used (either "a" or "A" but not both), so that the Excel sorting
'does not vary depending on sorting option "Ignore case".
iOrder = -1
Exit For
ElseIf Mid(sOrder, j, 1) <= sCharacter Then
'Compare characters based on the LOCALE order, that's possible because
'the directive "Option Compare Text" has been defined.
iOrder = j
End If
Next
If iOrder = 0 Then
sOrder = ChrW(constdebug + i) & sOrder
ElseIf iOrder = Len(sOrder) Then
sOrder = sOrder & ChrW(constdebug + i)
ElseIf iOrder >= 1 Then
sOrder = Left(sOrder, iOrder) & ChrW(constdebug + i) & Mid(sOrder, iOrder + 1)
End If
i = i + 1
Loop
'Last character is for any character of input text which is not in orderedCharacters
sOrder = sOrder & ChrW(constdebug + numOfChars)
getOrderedCharactersCurrentLocale = sOrder
End Function
Function getSortableCode(text As String, SortableCharacters() As String) As String
'Used to calculate a sortable text such a way it fits a given order of characters.
'Example: instead of order _, 0-9, Aa-Zz you may want 0-9, Aa-Zz, _
'Will work only if Option Compare Text is defined at the beginning of the module.
getSortableCode = ""
For i = 1 To Len(text)
If AscW(Mid(text, i, 1)) < UBound(SortableCharacters) Then
If SortableCharacters(AscW(Mid(text, i, 1))) <> "" Then
getSortableCode = getSortableCode & SortableCharacters(AscW(Mid(text, i, 1)))
Else
'Character has not an order sequence defined -> last in order
getSortableCode = getSortableCode & SortableCharacters(UBound(SortableCharacters))
End If
Else
'Character has not an order sequence defined -> last in order
getSortableCode = getSortableCode & SortableCharacters(UBound(SortableCharacters))
End If
Next
'For two texts "a1" and "A1" having the same sortable code, appending the original text allows using the sort option "Ignore Case"/"Respecter la casse"
getSortableCode = getSortableCode & " " & text
End Function
我的问题基本上与 THIS ONE 相反（它有一个基于数据库的解决方案，我不能在这里使用）。
我使用 SAP，它以这种方式对字符进行排序：
0-9, A-Z, _
但我正在将数据下载到 Excel 并根据正确的 SAP 字符集排序顺序处理范围。
如何强制 Excel 按照与 SAP 相同的方式排序，下划线排在最后。
在 Excel 的排序功能中尝试使用单个字符的自定义排序列表后，Excel still/always 排序如下：
_, 0-9, A-Z
有没有办法让 Excel 像 SAP 一样排序？如果需要，我可以执行 Excel 宏。
或者，如果有人知道如何让本机 SAP 表在 SAP 界面中像 Excel 一样排序，那么也可以解决这个问题。
编辑：此解决方案基于自定义订单列表的自动计算，但如果有太多不同的值，它就不起作用。在我的例子中，它使用了一个可能总共 35.000 个字符的自定义订单列表，但对于原始海报的大列表却失败了。
以下代码按 ASCII 值对请求的列进行排序，具有这种顺序：
0-9, A-Z, _, a-z
我猜小写字母与大写字母分开不是问题，因为 SAP 主要以大写字母定义值。如果需要，可以轻松调整代码以获得自定义订单 0-9, Aa-Zz, _（通过使用 UCase 和 worksheet.Sort.MatchCase = False）。
此顺序不同于基于语言环境的内置 Excel 排序顺序。例如，在英语中，它将是：
_, 0-9, Aa-Zz
原理是使用"custom order list"，其值取自Excel列，使其唯一，并使用QuickSort3算法排序（子程序MedianThreeQuickSort1 由 Ellis Dee 在 http://www.vbforums.com/showthread.php?473677-VB6-Sorting-algorithms-(sort-array-sorting-arrays)) 提供。
关于 Excel 通过自定义列表排序的性能说明（我不是在谈论 QuickSort3）：
- 自定义订单列表中的不同值越多，性能越低。具有 20 个不同值的 4,000 行会立即排序，但具有 4,000 个不同值的 4,000 行需要 8 秒才能排序！
- 对于相同数量的不同值，如果要排序的行很多，性能不会有太大变化。具有 6 个不同值的 300,000 行排序需要 3 秒。
Sub SortByAsciiValue()
With ActiveSheet.Sort
.SortFields.Clear
.SetRange Range("A:A").CurrentRegion
.SortFields.Add Key:=Columns("A"), Order:=xlAscending, _
CustomOrder:=DistinctValuesInAsciiOrder(iRange:=Columns("A"), Header:=True)
.Header = xlYes
.Apply
End With
End Sub
Function DistinctValuesInAsciiOrder(iRange As Range, Header As Boolean) As String
Dim oCell As Range
Dim oColl As New Collection
On Error Resume Next
For Each oCell In iRange.Cells
Err.Clear
If Header = True And oCell.Row = iRange.Row Then
ElseIf oCell.Row > iRange.Worksheet.UsedRange.Rows.Count Then
Exit For
Else
dummy = oColl.Item(oCell.Text)
If Err.Number <> 0 Then
oColl.Add oCell.Text, oCell.Text
totalLength = totalLength + Len(oCell.Text) + 1
End If
End If
Next
On Error GoTo 0
If oColl.Count = 0 Then
Exit Function
End If
Dim values() As String
ReDim values(1)
ReDim values(oColl.Count - 1 + LBound(values))
For i = 1 To oColl.Count
values(i - 1 + LBound(values)) = oColl(i)
Next
Call MedianThreeQuickSort1(values)
' String concatenation is complex just for better performance (allocate space once)
DistinctValuesInAsciiOrder = Space(totalLength - 1)
Mid(DistinctValuesInAsciiOrder, 1, Len(values(LBound(values)))) = values(LBound(values))
off = 1 + Len(values(LBound(values)))
For i = LBound(values) + 1 To UBound(values)
Mid(DistinctValuesInAsciiOrder, off, 1 + Len(values(i))) = "," & values(i)
off = off + 1 + Len(values(i))
Next
End Function
以下解决方案的原理是插入一个新列，其中的单元格有一个公式，该公式计算要排序的列的每个单元格的"sortable code"。
如果您对这个新列进行排序，行将按 ASCII 顺序排序 (0-9, A-Z, _)。
它应该能够处理任意数量的行。在我的笔记本电脑上，计算 130.000 行的单元格需要 1 分钟。有两个 VBA 函数，一个用于 ASCII，一个用于 EBCDIC。定义其他字符集非常容易。
步骤：
- 在您的 Excel 工作簿中创建一个模块并将代码放在下面。
- 关闭 VB 编辑器，否则 it will run slowly。
- 在要排序的工作表中，为要排序的每一列插入一列，例如假设要对 A 列进行排序，在单元格
B1插入公式=SortableCodeASCII(A1)并对 B 列的所有单元格（直到 A 列的最后一行）执行相同的操作。 - 确保公式计算结束（在我的笔记本电脑上130.000行需要1分钟），否则如果排序，顺序将不正确，因为公式尚未计算。您会在 Excel window 底部的状态栏上看到进度指示器（百分比）。如果看不到，请按 Ctrl+Alt+F9.
- 按 B 列排序。A 列中的值应根据 ASCII 顺序排序 (
0-9, A-Z, _)
祝你好运！
Option Compare Text 'to make true "a" = "A", "_" < "0", etc.
Option Base 0 'to start arrays at index 0 (LBound(array) = 0)
Dim SortableCharactersASCII() As String
Dim SortableCharactersEBCDIC() As String
Dim SortableCharactersTEST() As String
Sub ResetSortableCode()
'Run this subroutine if you change anything in the code of this module
'to regenerate the arrays SortableCharacters*
Erase SortableCharactersASCII
Erase SortableCharactersEBCDIC
Erase SortableCharactersTEST
Call SortableCodeASCII("")
Call SortableCodeEBCDIC("")
Call SortableCodeTEST("")
End Sub
Function SortableCodeASCII(text As String)
If (Not Not SortableCharactersASCII) = 0 Then
SortableCharactersASCII = getSortableCharacters( _
orderedCharacters:=" !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}" & ChrW(126) & ChrW(127))
End If
SortableCodeASCII = getSortableCode(text, SortableCharactersASCII)
End Function
Function SortableCodeEBCDIC(text As String)
If (Not Not SortableCharactersEBCDIC) = 0 Then
SortableCharactersEBCDIC = getSortableCharacters( _
orderedCharacters:=" ¢.<(+|&!$*);-/¦,%_>?`:#@'=""abcdefghi±jklmnopqr~stuvwxyz^[]{ABCDEFGHI}JKLMNOPQR\STUVWXYZ0123456789")
End If
SortableCodeEBCDIC = getSortableCode(text, SortableCharactersEBCDIC)
End Function
Function SortableCodeTEST(text As String)
If (Not Not SortableCharactersTEST) = 0 Then
SortableCharactersTEST = getSortableCharacters( _
orderedCharacters:="ABCDEF 0123456789_")
End If
SortableCodeTEST = getSortableCode(text, SortableCharactersTEST)
End Function
Function getSortableCharacters(orderedCharacters As String) As String()
'Each character X is assigned another character Y so that sort by character Y will
'sort character X in the desired order.
maxAscW = 0
For i = 1 To Len(orderedCharacters)
If AscW(Mid(orderedCharacters, i, 1)) > maxAscW Then
maxAscW = AscW(Mid(orderedCharacters, i, 1))
End If
Next
Dim aTemp() As String
ReDim aTemp(maxAscW)
j = 0
For i = 1 To Len(orderedCharacters)
'Was a character with same "sort weight" previously processed ("a" = "A")
For i2 = 1 To i - 1
If AscW(Mid(orderedCharacters, i, 1)) <> AscW(Mid(orderedCharacters, i2, 1)) _
And Mid(orderedCharacters, i, 1) = Mid(orderedCharacters, i2, 1) Then
'If two distinct characters are equal when case is ignored (e.g. "a" and "A")
'(this is possible only because directive "Option Compare Text" is defined at top of module)
'then only one should be used (either "a" or "A" but not both), so that the Excel sorting
'does not vary depending on sorting option "Ignore case".
Exit For
End If
Next
If i2 = i Then
'NO
aTemp(AscW(Mid(orderedCharacters, i, 1))) = Format(j, "000")
j = j + 1
Else
'YES "a" has same weight as "A"
aTemp(AscW(Mid(orderedCharacters, i, 1))) = aTemp(AscW(Mid(orderedCharacters, i2, 1)))
End If
Next
'Last character is for any character of input text which is not in orderedCharacters
aTemp(maxAscW) = Format(j, "000")
getSortableCharacters = aTemp
End Function
Function getOrderedCharactersCurrentLocale(numOfChars As Integer) As String
'Build a string of characters, ordered according to the LOCALE order.
' (NB: to order by LOCALE, the directive "Option Compare Text" must be at the beginning of the module)
'Before sorting, the placed characters are: ChrW(0), ChrW(1), ..., ChrW(numOfChars-1), ChrW(numOfChars).
'Note that some characters are not used: for those characters which have the same sort weight
' like "a" and "A", only the first one is kept.
'For debug, you may define constdebug=48 so that to use "printable" characters in sOrder:
' ChrW(48) ("0"), ChrW(49) ("1"), ..., ChrW(numOfChars+47), ChrW(numOfChars+48).
sOrder = ""
constdebug = 0 'Use 48 to help debugging (ChrW(48) = "0")
i = 34
Do Until Len(sOrder) = numOfChars
Select Case constdebug + i
Case 0, 7, 14, 15: i = i + 1
End Select
sCharacter = ChrW(constdebug + i)
'Search order of character in current locale
iOrder = 0
For j = 1 To Len(sOrder)
If AscW(sCharacter) <> AscW(Mid(sOrder, j, 1)) And sCharacter = Mid(sOrder, j, 1) Then
'If two distinct characters are equal when case is ignored (e.g. "a" and "A")
'("a" = "A" can be true only because directive "Option Compare Text" is defined at top of module)
'then only one should be used (either "a" or "A" but not both), so that the Excel sorting
'does not vary depending on sorting option "Ignore case".
iOrder = -1
Exit For
ElseIf Mid(sOrder, j, 1) <= sCharacter Then
'Compare characters based on the LOCALE order, that's possible because
'the directive "Option Compare Text" has been defined.
iOrder = j
End If
Next
If iOrder = 0 Then
sOrder = ChrW(constdebug + i) & sOrder
ElseIf iOrder = Len(sOrder) Then
sOrder = sOrder & ChrW(constdebug + i)
ElseIf iOrder >= 1 Then
sOrder = Left(sOrder, iOrder) & ChrW(constdebug + i) & Mid(sOrder, iOrder + 1)
End If
i = i + 1
Loop
'Last character is for any character of input text which is not in orderedCharacters
sOrder = sOrder & ChrW(constdebug + numOfChars)
getOrderedCharactersCurrentLocale = sOrder
End Function
Function getSortableCode(text As String, SortableCharacters() As String) As String
'Used to calculate a sortable text such a way it fits a given order of characters.
'Example: instead of order _, 0-9, Aa-Zz you may want 0-9, Aa-Zz, _
'Will work only if Option Compare Text is defined at the beginning of the module.
getSortableCode = ""
For i = 1 To Len(text)
If AscW(Mid(text, i, 1)) < UBound(SortableCharacters) Then
If SortableCharacters(AscW(Mid(text, i, 1))) <> "" Then
getSortableCode = getSortableCode & SortableCharacters(AscW(Mid(text, i, 1)))
Else
'Character has not an order sequence defined -> last in order
getSortableCode = getSortableCode & SortableCharacters(UBound(SortableCharacters))
End If
Else
'Character has not an order sequence defined -> last in order
getSortableCode = getSortableCode & SortableCharacters(UBound(SortableCharacters))
End If
Next
'For two texts "a1" and "A1" having the same sortable code, appending the original text allows using the sort option "Ignore Case"/"Respecter la casse"
getSortableCode = getSortableCode & " " & text
End Function