枠の左と真ん中と右の数字を分けて昇順に並べる方法

質問

このカテゴリーのエクセルの達人の方々に質問です。
どなたか回答して頂ける方がおみえでしたらよろしくお願いします。
（ちゃんとした回答ではなく、文句やクレーム等を混ぜた記載はご遠慮ください。
　私の質問が気に入らない場合は無視して頂ければ結構です。）
【質問】
　添付図のとおり、７列×５行の中に数字が１～37まであり、
　重複数字を含んでおり、それが４つ（A,B,C,D）あります。
　その中で、１列～２列、３列～５列、６列～７列と数字を分けて下段に
　「〇中」、「〇左」、「〇右」として左から右へ昇順に並べます。　

上記を実現する方法をＶＢＡで実現する方法が知りたいです。

【注意事項】
　　・７列×５行の中にある数字の並びは毎回異なります。
　　・枠線や塗り潰しの橙色や緑色や青色は、説明のために付けているだけです。
　　・ＶＢＡで実現する方法～、と書きましたが、
　　　同様のことが他の方法でも実現できればそれを教えて下さい。
　　・使用するエクセルは２０２１です。

以上、よろしくお願いします。

回答No.1

kkkkkm · ベストアンサー

以前のコードを今回に合わせたものです。

Sub Test()
Dim mRng As Range
Dim i As Long, j As Long, k As Long
Dim mR As Long, mC As Long
Dim x As Double
j = 0: k = 0: mC = 0: mR = 0
Application.ScreenUpdating = False
For i = 1 To 4
mC = 0
For Each mRng In Range("C1:E5").Offset(j, k)
Range("B14").Offset(mR, mC).Value = mRng.Value
mC = mC + 1
Next
Range(Cells(14 + mR, 2), Cells(14 + mR, mC + 1)).Sort _
Key1:=Cells(14 + mR, "A"), Order1:=xlAscending, Orientation:=xlSortRows

mC = 0
For Each mRng In Range("A1:B5").Offset(j, k)
Range("B18").Offset(mR, mC).Value = mRng.Value
mC = mC + 1
Next
Range(Cells(18 + mR, 2), Cells(18 + mR, mC + 1)).Sort _
Key1:=Cells(18 + mR, "A"), Order1:=xlAscending, Orientation:=xlSortRows

mC = 0
For Each mRng In Range("F1:G5").Offset(j, k)
Range("B22").Offset(mR, mC).Value = mRng.Value
mC = mC + 1
Next
Range(Cells(22 + mR, 2), Cells(22 + mR, mC + 1)).Sort _
Key1:=Cells(22 + mR, "A"), Order1:=xlAscending, Orientation:=xlSortRows

mR = mR + 1
k = k + 8
If i = 2 Then
j = j + 6
k = 0
End If
Next
Application.ScreenUpdating = True
End Sub

お礼

お世話になります。 前回のＶＢＡを改修するだけの知恵が無いので質問させていただきました。 ソース実行して得たい結果になりました。 ありがとうございました。

Powered by GRATICA

回答No.2

kon555

VBA以外の方法です。

　Excel365であれば、そのものズバリなソート用関数があります。
https://www.crie.co.jp/chokotech/detail/566/

　あとはデータの数が決まっているなら、LARGE関数という『上から数えて◯番目』を抽出する関数でも対応可能です。
https://kokodane.com/kansu_statistics_49.htm

お礼

はじめまして。 回答いただきありがとうございます。 EXCELにSORT関数なんてあるのですね。 初めて知りました。参考にさせていただきます。

Powered by GRATICA