VBA100本ノック 36本目：列の並べ替え

最終更新日：2021-02-22

VBA100本ノック 36本目：列の並べ替え

列見出しの()内の数値で列を並べ替える問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

#VBA100本ノック 36本目
1行目の見出しの後ろには半角括弧()の中に数値が入っています。
この()括弧内の数値の昇順で列を並べ替えてください。
・全ての列に数値の入った()が正しく最後についています。
・数値は1~3桁の正の整数です。
※非表示列はありません。
※シートは任意

サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_36.xlsm
https://excel-ubara.com/vba100sample/VBA100_36.zip

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

100本ノックで並べ替えは2本目です。
前回はシートの並べ替えでした。
その時のバブルソートがそのまま使えます。
キーの取り出しは関数にしています。
数値化ではVal関数を使用しました。後ろの数値以外を無視してくれます。


  
    
      Sub VBA100_36_01()

　　Dim ws As Worksheet

　　Dim maxCol As Long

　　Set ws = ActiveSheet

　　maxCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

　　

　　Application.ScreenUpdating = False

　　

　　Dim i As Long, j As Long

　　For i = maxCol To 1 Step -1

　　　　For j = 1 To i - 1

　　　　　　If getSortKey(ws.Cells(1, j)) > getSortKey(ws.Cells(1, j + 1)) Then

　　　　　　　　ws.Columns(j + 1).Cut

　　　　　　　　ws.Columns(j).Insert

　　　　　　End If

　　　　Next

　　Next

　　

　　Application.ScreenUpdating = True

      End Sub


Function getSortKey(ByVal arg As String) As Long

      　　getSortKey = Val(Mid(arg, InStrRev(arg, "(") + 1))

End Function

列の並べ替えなら、行（横）方向にキーがあればエクセルの機能として列の並べ替えが使えます。
キーの取り出しは、先のFunctionをそのまま使います。
表範囲のすぐ下にキー値を出力し、その行の値で列方向に並べ替えしています。


  
    
      Sub VBA100_36_02()

　　Dim ws As Worksheet

　　Dim keyRng As Range

　　Set ws = ActiveSheet

　　With ws.Range("A1").CurrentRegion

　　　　Set keyRng = .Offset(.Rows.Count).Resize(1)

　　End With

　　

　　Application.ScreenUpdating = False

　　

　　Dim i As Long

　　For i = 1 To keyRng.Count

　　　　keyRng(i).Value = getSortKey(ws.Cells(1, i))

　　Next

　　

　　With ws.Sort

　　　　.SortFields.Clear

　　　　.SortFields.Add Key:=keyRng, _

　　　　　　　　　　　　SortOn:=xlSortOnValues, _

　　　　　　　　　　　　Order:=xlAscending

　　　　.SetRange ws.Range("A1").CurrentRegion

　　　　.Header = xlNo

　　　　.Orientation = xlLeftToRight

　　　　.Apply

　　End With

　　

　　keyRng.ClearContents

　　Application.ScreenUpdating = True

End Sub

今回は3桁以内という制限を付けました。
数値の範囲が制限されているなら、いわゆるバケットソートも使えます。
また、365ならシート関数のSortByを使う事も出来ます。
これらのVBAは記事補足に掲載しました。

補足

上記も含めて4通り作成しました。

・バブルソート
・エクセル機能の並べ替え
・バケットソート
・シートのSortBy関数

どれも一長一短がありますが、処理速度としては列の入れ替えにかかる時間が大きいです。
エクセル機能の並べ替えを使う方法が処理速度的には有利だと思います。

以下、キーの取り出しは先のFunctionをそのまま使います。
Function getSortKey

バケットソート


  
    
      Sub VBA100_36_03()

　　Dim ws As Worksheet

　　Dim maxCol As Long

　　Set ws = ActiveSheet

　　maxCol = ws.Range("A1").CurrentRegion.Columns.Count

　　

　　Application.ScreenUpdating = False

　　

　　Dim i As Long

      　　Dim ary() As Collection

　　ReDim ary(999)

　　For i = 1 To maxCol

　　　　If ary(getSortKey(ws.Cells(1, i))) Is Nothing Then

　　　　　　Set ary(getSortKey(ws.Cells(1, i))) = New Collection

　　　　End If

　　　　ary(getSortKey(ws.Cells(1, i))).Add ws.Columns(i)

　　Next

　　

　　Dim col As Range

　　For i = 1 To 999

　　　　If Not ary(i) Is Nothing Then

　　　　　　For Each col In ary(i)

　　　　　　　　col.Cut

　　　　　　　　ws.Columns(maxCol + 1).Insert

　　　　　　Next

　　　　End If

　　Next

　　

　　Application.ScreenUpdating = True

End Sub

同一値を考慮してCollectionを使いましたが、同一値が無ければもっと簡単に済みます。

シートのSortBy関数


  
    
      Sub VBA100_36_04()

　　Dim ws As Worksheet

　　Dim maxCol As Long

　　Set ws = ActiveSheet

　　maxCol = ws.Range("A1").CurrentRegion.Columns.Count

　　

　　Application.ScreenUpdating = False

　　

　　Dim arySht() As Long, aryKey() As Long

　　ReDim arySht(1 To maxCol, 1 To 2)

　　ReDim aryKey(1 To maxCol, 1 To 1)

　　

　　Dim i As Long, arySort

　　For i = 1 To maxCol

　　　　arySht(i, 1) = getSortKey(ws.Cells(1, i))

　　　　arySht(i, 2) = i

　　　　aryKey(i, 1) = arySht(i, 1)

　　Next

　　arySort = WorksheetFunction.SortBy(arySht, aryKey, 1)

　　

　　For i = UBound(arySort, 1) To LBound(arySort, 1) Step -1

　　　　ws.Columns(arySort(i, 2)).Copy

　　　　ws.Columns(maxCol + 1).Insert

　　Next

　　

　　ws.Range(ws.Columns(1), ws.Columns(maxCol)).Delete

　　

　　Application.ScreenUpdating = True

End Sub

SortBy関数はオブジェクトを扱えないので、2次元配列にキー値と列位置を入れました。

サイト内関連ページ

第28回．セル・行・列の選択（Select,ActivateとCurrentRegion）

マクロVBAで、セル、行、列を選択するときの記述について説明します。まずは、セルの選択について説明する前に、選択セルとアクティブセルについて、説明する必要があります。選択セルとアクティブセルこの状態では、選択セルは、B2～C6の10個のセルです。

第29回．セル・行・列の削除・挿入（Delete,Insert）

単一セルまたは複数セルの削除・挿入と行・列の削除・挿入についてのマクロVBAを解説します。単一セルまたは複数セルを指定しての行全体・列全体に対する削除・挿入と、行・列を指定しての削除・挿入は結果としては同じ事になりますが、マクロVBAの書き方には違いがあり、実際のVBAでは使い分けが必要になる場合があります。

第88回．並べ替え（Sort）

並べ替えは、データ処理の基本中の基本です、乱雑なデータを並べ替えることは、データ処理の第一歩です。マクロVBAで並べ替えを実行するには、シート操作の「並べ替え」の機能を使用することになります。そもそもデータを並べ替えるという事は、そのデータのキーが何かを考えるという事です。

同じテーマ「VBA100本ノック」の記事

33本目：マクロ記録の改修
 34本目：配列の左右回転
 35本目：条件付き書式
36本目：列の並べ替え
37本目：グラフの色設定
 38本目：1シートを複数シートに振り分け
 39本目：数値リストの統合（マージ）
40本目：複数ブックの統合
 41本目：暗算練習アプリ
 42本目：データベース形式に変換
 43本目：CSV出力

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.Excelショートカットキー一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.RangeとCellsの使い方｜VBA入門
5.繰り返し処理（For Next)｜VBA入門
6.マクロって何？VBAって何？｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
9.セルに文字を入れるとは（Range,Value）｜VBA入門
10.並べ替え（Sort）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
36本目：列の並べ替え

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 36本目：列の並べ替え