ローマ字、ハイフン付きの並び替えローマ字抽出方法 Excelマクロ

Question

ローマ字、ハイフン付きの並び替えのマクロを下記の通り組んでみました。ローマ字抽出に苦労しましたが他の方法はありませんでしょうか。

1　No............. No
2 1-3.............. 1-1
3 m2-5........... 1-3
4 1-1.............. 4-2
5 n1-2............ 5-6
6 k2............... 10
7 5-6.............a11-3
8 a11-3......... k2
9 4-2............ m2-5
10 10............. n1-2

Sub 並び替え150()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "a").End(xlUp).Row
Range("a:c").Insert
With Range(Cells(2, "a"), Cells(lastRow, "a"))
.Formula = "=IF(OR(AND(CODE(d2)>=65,CODE(d2)<=90),AND(CODE(d2)>=97,CODE(d2)<=122)),LEFT(d2,1),"""")"
End With
With Range(Cells(2, "b"), Cells(lastRow, "b"))
.Formula = "=IF(a2="""",d2,MID(d2,2,10))"
End With
With Range(Cells(2, "c"), Cells(lastRow, "c"))
.Formula = "=IF(ISNUMBER(FIND(""-"",b2)),LEFT(b2,FIND(""-"",b2)-1)*1000+MID(b2,FIND(""-"",b2)+1,3),b2*1000)"
.Value = .Value
End With
Range("a2:e" & lastRow).Sort _
key1:=Range("a1"), order1:=xlAscending, _
Key2:=Range("c1"), order2:=xlAscending, DataOption2:=xlSortTextAsNumbers
Range("A:c").Delete
End Sub

ありがとうございます。例題としてA列に数値を入力してありますが、実際はB列、C列、D列に文字または数値が入った表となっています。A列を基本としてA列～D列全体の並び替えをするにはどうすればよろしいでしょうか。ご回答マクロを確認させていただきましたがA列のみの並び替えでしょうか？
勉強不足で申し訳ありません。理解するまで時間がかかりそうです。もう少し時間をください。

No.3の回答に寄せられた補足コメントです。補足日時：2022/04/02 13:56
通報する

通報する

fujillin · Accepted Answer

No3です。

＞ご回答マクロを確認させていただきましたがA列のみの並び替えでしょうか？
A列の最終行までに限定してあります。
（実際には、一時的に追加したA:C列とD列（＝元のA列）を含む4列です）

＞A列を基本としてA列～D列全体の並び替えをするにはどうすればよろしいでしょうか。
Sortメソッドの対象列数を広げれば良いだけです。
元のA:Dの4列にするのなら、追加の3列分を含めて7列ということになりますので、

修正前
　Cells(2, 1).Resize(n - 1, 4).Sort _

修正後
　Cells(2, 1).Resize(n - 1, 7).Sort _

とすれば、7列分（＝実質的には4列）が対象になります。

※ 並べ替え前にシートがどうなっているのかを確認なさりたければ、上記のSortの直前の行に Stop 等を追加することで、実行が一時停止するようになりますので、並べ替え前のシートの状態を見ることができます。

fujillin · Answer

No1です。

＞正規表現等の仕方がわからないためローマ字抽出に関数を使用しました。
シートを使わないソートの例はNo2様がご提示なさっているので、正規表現の例を以下に・・
No1でも記しましたように、どうせ正規表現を用いるなら、最初の文字列だけでなく数字部分もまとめて抽出してしまう方が簡単だと思います。

※ 抽出に正規表現を用いているだけで、手順としてはご提示の方法と全く同じです。
　（ですので、コードから関数部分が無くなっただけみたいなものです）
※ 1セルずつ入力すると遅いので、一旦、配列に入れてからまとめてセルに記入しています。
※ 与えられる文字列の形式が不明なままですが、正規表現をNo1より少し緩くしてあります。
　　　(数値以外の文字列)(数値の文字列)-(数値の文字列)
　という形式で、それぞれ複数文字あっても良いものと仮定しました。
　また、最初の数値部分のみを必須としてあります。（他はなくても可）
※ 形式に適合しないデータの場合(例：ab12-34-56)は、全体の最後に並ぶようにしてあります。
※ 抽出部分をそのまま利用して、keyを3つとしてソートする方式にしてあります。

以下ご参考にでもなれば・・

Sub Q12878498()
Dim re As Object, mc As Object
Dim n As Long, v()

Set re = CreateObject("VBScript.RegExp")
re.Pattern = "^(\D+)?(\d+)-?(\d+)?$"
n = Cells(Rows.Count, 1).End(xlUp).Row
If n < 2 Then Exit Sub

ReDim v(1 To n, 1 To 3)
For rw = 2 To n
Set mc = re.Execute(Cells(rw, 1).text)
If mc.Count > 0 Then
v(rw, 1) = mc.Item(0).SubMatches(0) & " "
v(rw, 2) = mc.Item(0).SubMatches(1)
v(rw, 3) = mc.Item(0).SubMatches(2)
If v(rw, 3) = "" Then v(rw, 3) = -1
End If
Next rw

Application.ScreenUpdating = False
Range("A:C").Insert
Cells(1, 1).Resize(n, 3).Value = v
Cells(2, 1).Resize(n - 1, 4).Sort _
key1:=Range("A2"), key2:=Range("B2"), key3:=Range("C2")
Range("A:C").Delete
Application.ScreenUpdating = True
End Sub

Qchan1962 · Answer

こんばんは、
ソートが問題ですね。作業列を使い、シートのソートを使って
上手く処理されていると思います。＃１様も回答されている通り便利ですしソートにおける処理速度も速いですね。
あと加えるとしても、シートをいじるので
Application.ScreenUpdatingやイベントトリガーがあるのであれば
Application.EnableEvents　などでしょうか。

作業列を使うのですから、関数式で求めるのも良いと思います。
他の方法と言ってもシート上のソートを使うのであれば、あまり変わらないと思います。

シート上のソート、関数を使わないとなると　ループ、正規表現、配列を使う方法でしょうか・・期待する順位になるかどうか・・
可読性、判読性はどうしても落ちると思いますし・・

Sub Test()
    Dim ary() As Variant, s As Variant
    Dim r As Range
    Dim n As Long, k As Long
    Dim moji As String
    Dim tmp As Variant, tmp1 As Variant    '使い回し(数値比較)の為 As Variant

ReDim ary(1 To Range(Cells(2, "a"), Cells(Rows.Count, "a").End(xlUp)).Count, 1 To 2)

For Each r In Range(Cells(2, "a"), Cells(Rows.Count, "a").End(xlUp))
        '文字列作成
        For k = 1 To Len(r)
            moji = Mid(r, k, 1)
            If moji Like "[0-9-@]" Then
                tmp = tmp & moji
            Else
                tmp1 = tmp1 & moji
            End If
        Next
        '文字（数値）加工・・　配列へ　2が加工数値
        n = n + 1
        s = Split(tmp, "-")
        ary(n, 1) = r.Text
        If tmp1 = "" Then
            If UBound(s) = 0 Then
                ary(n, 2) = s(0) * 1000
            Else
                ary(n, 2) = s(0) * 1000 + s(1)
            End If
        Else
            If UBound(s) = 0 Then
                ary(n, 2) = tmp1 & s(0) * 1000
            Else
                ary(n, 2) = tmp1 & s(0) * 1000 + s(1)
            End If
        End If
        tmp = "": tmp1 = ""
    Next
    '配列次元キー2でSort
    For n = LBound(ary) + 1 To UBound(ary)
        tmp1 = ary(n, 1)
        tmp = ary(n, 2)
        If ary(n - 1, 2) > tmp Then
            k = n
            Do While k > LBound(ary)
                If ary(k - 1, 2) <= tmp Then
                    Exit Do
                End If
                ary(k, 2) = ary(k - 1, 2)
                ary(k, 1) = ary(k - 1, 1)
                k = k - 1
            Loop
            ary(k, 2) = tmp
            ary(k, 1) = tmp1
        End If
    Next
    '結果出力
    Range("a2").Resize(UBound(ary), 1) = ary

End Sub

元のテキスト例が良く分かりませんが、ISNUMBER(FIND(""-"",b2)などから想像して　配列を使って書いて見ました。結果は、元テキストによるかもしれませんので解りません。（簡単なテストのみ）

正規表現についてはざっくりです、出力先へはフォーマットが必要かも
もっとまとめられるかもしれませんが、遊びのような回答になってしまいました。
やはり、シートを使う関数には視認性などでは勝てないですね
ご質問欄に掲示されているVBA方が判り易いです

fujillin · Answer

こんばんは

並べ替えに関してはkeyが2つになるようなので、ご提示のように、エクセルのSortメソッドを使うのが便利と思います。

＞ローマ字抽出に苦労しましたが他の方法はありませんでしょうか。
キーの抜き出しに関数を利用していらっしゃいますが、正規表現等の方が簡単と想像します。
元のテキストの取りうる想定内容がわかりませんけれど、例えばパターンを
　"^(\D*)(\d+)-?(\d?)$"
等としておくことで、ご例示のものであれば全てヒットしますし、「アルファベット」、「最初の数字」、「次の数字」の順にSubMatchesに格納されます。
（存在しない部分は、空白文字列になります）

数字部分はひとつに纏めなくても、別列のままでkeyの順位でソートすることも考えられそうですね。(key3まで指定可能ですので）

とは言っても、全体の手順はたいして変わらないので、効果としては、コードの視認性が良くなる程度かも知れませんけれど・・

ローマ字、ハイフン付きの並び替え ローマ字抽出方法 Excelマクロ

No3です。

No1です。

こんばんは、

こんばんは

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

ローマ字、ハイフン付きの並び替えローマ字抽出方法 Excelマクロ