前提・実現したいこと
Excelで並べ替えをしたい。
列1 | 列2 | 列3 |
---|---|---|
100 | A0001-1 | あ |
100 | A0002-1 | お |
100 | A0011-1 | か |
100 | B0001-1 | き |
100 | B0001-1-1 | き |
101 | A0001-1 | い |
101 | A0001-2 | え |
101 | A0001-12 | か |
というような感じで並べ変えをしたい。
第1ソートキーは列1で第2ソートキーは列2です。
ただし、ソートはハイフン区切りで数値化できるものは数値化してソートです。
標準機能のソートでは、実現できないカスタムなソートを
どのように実現すればいいのかという質問です。
プログラミング言語によっては、カスタムなCompare関数を定義して
ソートを実行するとかいう感じです。
ソート用の比較関数は、以下のようなものを作成済みと考えてください。
VBA
1Public Function myCompare(a1 As String, a2 As String, b1 As String, b2 As String) As Long 2 ' aとbの比較を行って、aの方が小さい場合は-1、同じ場合は0、aの方が大きい場合は1を返す 3 ' 実装は略 4End Function
また、ソート処理を実装するマクロとソート処理対象のエクセルは別ファイルを想定しています。
どのような実装を行えば、これが実現できるのか検討しています。
何かいい方法があれば教えてください。
試してみようとしていること
今考えているマクロの内容は
1.選択範囲の表の最終列のもう一つ右の列に、順位を数値で設定
2.順位の列でソート
3.順位の列を削除
という感じなのを考えています。
補足情報(FW/ツールのバージョンなど)
Office 365
追記
ソート用の列を追加するという上述の案の方針で
以下のような実装をしてみました。
このままではソートのアルゴリズムが遅いので、早いソートのアルゴリズムにすれば
少しは早くなりました。
VBA
1Public Sub CallSort(rRange As Range) 2 Dim tSheet As Worksheet 3 Set tSheet = rRange.Parent 4 Dim tRange As Range 5 Set tRange = rRange 6 7 tRange.Columns(tRange.Columns.Count + 1).Insert Shift:=xlToRight 8 9 Dim tCol1 As Range 10 Dim tCol2 As Range 11 Set tCol1 = tRange.Columns(1) 12 Set tCol2 = tRange.Columns(2) 13 14 Dim tV1 As Variant 15 Dim tV2 As Variant 16 17 Dim tR1 As Long 18 Dim tR2 As Long 19 Dim tC1 As Long 20 Dim tC2 As Long 21 22 23 tR1 = tRange.Row 24 tR2 = tR1 + tRange.Rows.Count - 1 25 tC1 = tRange.Column 26 tC2 = tC1 + tRange.Columns.Count 27 28 Set tRange = tSheet.Range(tSheet.Cells(tR1, tC1), tSheet.Cells(tR2, tC2)) 29 30 tV1 = tCol1.Value 31 tV2 = tCol2.Value 32 33 ReDim tOrder(1 To UBound(tV1, 1)) 34 ReDim tOrder2(1 To UBound(tV1, 1)) 35 For tR = 1 To UBound(tV1, 1) 36 tOrder(tR) = tR 37 Next 38 39 MySort tOrder, tV1, tV2 40 41 For tR = 1 To UBound(tV1, 1) 42 tOrder2(tOrder(tR)) = tR 43 Next 44 45 tRange.Columns(tRange.Columns.Count).Value = WorksheetFunction.Transpose(tOrder2) 46 47 tSheet.Sort.SortFields.Clear 48 tSheet.Sort.SortFields.Add2 Key:=tRange.Columns(tRange.Columns.Count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 49 With tSheet.Sort 50 .SetRange tRange 51 .Header = xlNo 52 .MatchCase = False 53 .Orientation = xlTopToBottom 54 .SortMethod = xlPinYin 55 .Apply 56 End With 57 tRange.Columns(tRange.Columns.Count).Delete Shift:=xlToLeft 58 59End Sub 60 61Public Sub MySort(r_AryRow As Variant, r_V1 As Variant, r_V2 As Variant) 62 Dim i As Long 63 Dim j As Long 64 Dim tTmp As Variant 65 For i = UBound(r_AryRow) To LBound(r_AryRow) + 1 Step -1 66 For j = LBound(r_AryRow) To i - 1 67 Dim rtn As Long 68 rtn = Compare(r_V1(r_AryRow(j), 1), r_V2(r_AryRow(j), 1), r_V1(r_AryRow(j + 1), 1), r_V2(r_AryRow(j + 1), 1)) 69 If rtn > 0 Then 70 tTmp = r_AryRow(j) 71 r_AryRow(j) = r_AryRow(j + 1) 72 r_AryRow(j + 1) = tTmp 73 End If 74 Next 75 Next 76End Sub
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2021/12/07 14:29
2021/12/08 00:25
2021/12/08 01:29
2021/12/11 00:28