Excelは、デフォルトの米国の文字セットとは異なる方法でソートできますか？

Question

私の質問は、基本的に THIS ONE の反対です（これには、ここでは使用できないデータベースベースのソリューションがありました）。

私はSAPを使用しており、次のように文字を並べ替えます。

0-9、A-Z、_

しかし、Excelにデータをダウンロードし、正しいSAP文字セットの並べ替え順序に応じて範囲を操作しています。

アンダースコアを最後にして、ExcelにSAPと同じ方法でソートを強制するにはどうすればよいですか。

Excelの並べ替え機能で単一の文字のカスタム並べ替えリストを試した後も、Excelは次のように/常に並べ替えます。

_、0-9、A-Z

ExcelをSAPのように並べ替える方法はありますか？必要に応じて、Excelマクロを実行できます。

または、SAPインターフェースでネイティブSAPテーブルをExcelのようにソートする方法を知っている人がいる場合は、この問題にも対処できます。

Answer 1

次のソリューションの原則は、セルが数式を使用して、ソートする列の各セルの「ソート可能なコード」を計算する新しい列を挿入することです。

この新しい列を並べ替えると、行はASCIIの順序（_0-9, A-Z, __））で並べ替えられます。

任意の数の行を処理できる必要があります。私のラップトップでは、130.000行のセルの計算に1分かかります。 2つのVBA関数があり、1つはASCII用、もう1つはEBCDIC用です。他の文字セットを定義するのは非常に簡単です。

手順：

• Excelブックにモジュールを作成し、以下のコードを配置します。
• VBエディタを閉じます。それ以外の場合は ゆっくり実行されます 。
• 並べ替えるワークシートで、並べ替える列ごとに1つの列を挿入します。たとえば、列Aに対して並べ替えを実行し、セルBに新しい列Bを作成するとします_B1_ insert the式=SortableCodeASCII(A1)そして、列Bのすべてのセル（列Aの最後の行まで）に対して同じことを行います。
• 数式の計算が終わっていることを確認します（私のラップトップでは130.000行で1分かかります）。そうでない場合、並べ替えると、数式がまだ計算されていないため、順序が正しくありません。 Excelウィンドウの下部にあるステータスバーに進行状況インジケーター（パーセンテージ）が表示されます。表示されない場合は、 Ctrl+Alt+F9。
• 列Bでソートします。列Aの値は、ASCII order（_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
_

Answer 2

編集：このソリューションはカスタム注文リストの自動計算に基づいていますが、個別の値が多すぎる場合は機能しません。私の場合、合計35.000文字のカスタムオーダーリストで機能しましたが、元のポスターの大きなリストでは失敗しました。

---

次のコードは、要求された列を[〜＃〜] ascii [〜＃〜]の値でソートします。

0-9、A-Z、_、a-z

SAPはほとんどの場合大文字で値を定義するため、小文字と大文字を分離することは問題ではないと思います。必要に応じて、コードを簡単に調整してカスタムオーダーを取得できます0-9, Aa-Zz, _（UCaseおよびworksheet.Sort.MatchCase = Falseを使用）。

この順序は、ロケールに基づく組み込みのExcelの並べ替え順序とは異なります。たとえば、英語では次のようになります。

_、0-9、Aa-Zz

原則は、値がExcel列から取得され、一意にされ、QuickSort3アルゴリズム（サブルーチンMedianThreeQuickSort1http://www.vbforums.com/showthread.php?473677-VB6-Sorting-algorithms-（sort-array-sorting-arrays） ）でEllis Deeによって提供されています。

カスタムリストによる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