VBAの勉強を始めてみた

色々試しています。

表をオリジナルの順番で並び替える

Sheet1に人口順に並んだ、47都道府県の表があります。この表を北から順番(北海道→青森→岩手・・・のように)に並べ替えるにはどうしたらいいでしょうか?
EXCELの標準機能では昇順・降順、あいうえお順、日付順、曜日順等で並べ替えることはできますが、人間のみが理解できるあいまいな順番で並び替えをすることはできません。
今回はそういう、昇順・降順でもなく、あいうえお順等でもない順番で表を並び替えるマクロを作ってみました。

 

f:id:kouten0430:20170802233450j:plain

例えばSheet1に人口順に並んだ、47都道府県の表があります。

これを、Sheet2のA列(都道府県が北から順番に並んでいる)を手本に、Sheet1の表全体を並び替えるには・・・・・・

 

f:id:kouten0430:20170802234130j:plain

f:id:kouten0430:20170802234313j:plain

A列の北海道から沖縄まで(列見出しの「都道府県」は除く)を選択して、前回のマクロ(選択範囲のデータをカンマ区切りでクリップボードに格納 )を実行して下さい。

 

f:id:kouten0430:20170802234636j:plain
このように、カンマで区切られた北海道から沖縄までのデータがクリップボードに格納されます。(セルを選択した順番でカンマ区切りで並びます)

 

f:id:kouten0430:20170802234832j:plain

次に、Sheet1の並び替えしたい範囲を選択(列見出しを除く)して、今回のマクロ(選択範囲をオリジナルの順番で並び替える)を実行して下さい。

 

f:id:kouten0430:20170802234923j:plain

これで、クリップボード内のデータを参照し、Sheet1の表が北海道~沖縄の順番で並び替わりました。

 

上記の例では都道府県名の列が左端でしたが、並び替えのキーとなる列が左端以外の場合も説明しときます。

 

f:id:kouten0430:20170802235138j:plain

f:id:kouten0430:20170802235215j:plain

並び替える範囲を選択した後、Tabキーでアクティブセル(白抜きとなっているセル)をキー列まで移動します。

 

f:id:kouten0430:20170802235327j:plain

クリップボードに並び替え用のデータが格納された状態で、先程と同じくマクロを実行すると、並び替えが完了します。

 

なお、上記と同じようなオリジナルでの並び替えが、EXCELのオプション-詳細設定-ユーザー設定リストの編集にてユーザー設定リストを追加することでもできますが・・・・・・ユーザー設定リストの編集で直接リスト入力やリストをインポートする場合に、下記エラーによってリスト化できないことがあります。

 

f:id:kouten0430:20170802235551j:plain

 

「ユーザー設定リストの最大長を超えています。最初の255文字のみ保存されます。」

 

f:id:kouten0430:20170803000210j:plain

 

 

「リストには、単純な文字列が入力されているセルだけが取り込まれます。」

しかし、上記のようなエラーでリスト化できない文字列でも、マクロであれば無関係にリスト化(クリップボード上で仮想リスト化)し、並び替えすることができます。

 

 

マクロを使用するには、事前にVBEからMicrosoft Forms 2.0 Object Libraryを参照設定する必要があります。
(ツール→参照設定→参照からWindows\System32\FM20.DLLを選択)

***************************************

Sub 選択範囲をオリジナルの順番で並び替える()
    'Microsoft Forms 2.0 Object Libraryを参照設定して下さい
    'あらかじめ、オリジナルの順番をカンマ区切りでクリップボードに格納しておいて下さい
    '範囲選択後、Tabキーでアクティブセル(白抜き)を並び替えのキーとなる列に移動して下さい
    Dim V As String
   
    Set Dobj = New DataObject
    With Dobj
        .GetFromClipboard
        On Error Resume Next
        V = .GetText
        On Error GoTo 0
    End With
   
    If V <> Empty Then
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add Key:=ActiveCell, CustomOrder:="""," & V & """"
            .SetRange Selection
            .Header = xlNo
            .Apply
        End With
    Else
        MsgBox "クリップボードにデータがありません!"
    End If
End Sub

***************************************

 ※SubからEnd Subまでをコピペしてマクロを使用できます。使用の際は自己責任でお願いいたします。

 

使用する際の注意
マクロで行った処理は「元に戻す」ことができない為、マクロ実行前に保存することをお勧めします。

 

クリップボード上に並び替え用の仮想リストを作成するマクロはこちら 

kouten0430.hatenablog.com