セルの値をバラバラに並べ替えたい
特になんらかのデータのテストを行いたい場合に多いのですが、複数あるデータを規則性がない状態で並べ替えたい場合があります。
こんな感じです。
Excelでの並べ替え機能は、列に特化していたり昇順や降順がメインできれいに並べ替えることを目的としていますが、やりたいことはその逆で、めちゃくちゃに並べたい、という話です。行や列に関係なく不規則に並べ替える方法がないのもあります。
そういう機能はExcelにはないので手で並べるか、VBAで作ることになります。
以下では選択セル範囲の値をバラバラにするコードを紹介します。
選択セル範囲の値をランダムに並べ替えるコード
以下の関数は選択セル範囲の値をランダムに入れ替えます。使い方もそのままで、入れ替えたい値があるセル範囲を選択して実行します。
入れ替えているのはセルの値だけになるため、RangeオブジェクトのValue値のみを対象としています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 |
Sub SwapCellValue() Dim r As Range '// セル Dim i '// ループカウンタ Dim iCellCount As Long '// セル数 Dim iRnd As Long '// 乱数値 Dim arCell() As String '// セル値配列 Dim s As String '// 一時保管セル値 '// 選択セル数を取得 iCellCount = Selection.Count '// 複数セルが選択されていない場合は処理を抜ける If iCellCount < 2 Then Exit Sub End If '// 配列初期化 ReDim arCell(iCellCount - 1) '// 配列に選択セル範囲のセル値を格納 i = 0 For Each r In Selection '// 配列にセル値を設定 arCell(i) = r.Value i = i + 1 Next '// 擬似乱数列を初期化 Call Randomize '// 選択セル数ループ（フィッシャー-イェーツの並べ替えアルゴリズム改良版） For i = iCellCount - 1 To 1 Step -1 '// 配列のインデックスを乱数で取得 iRnd = Int((i + 1) * Rnd) '// 配列のインデックスの乱数値と末尾を入れ替える s = arCell(iRnd) arCell(iRnd) = arCell(i) arCell(i) = s Next Application.ScreenUpdating = False '// セルに並べ替えた値を反映 i = 0 For Each r In Selection r.Value = arCell(i) i = i + 1 Next Application.ScreenUpdating = True End Sub |
セルを複数選択して実行するたびに選択範囲内で値が入れ替わります。
空白セルが選択範囲に含まれていても動作するため、値が入っているセルだけで入れ替えたい場合は空白セルは選択しないようにして実行する必要があります。
コード説明
上のコードは大きく３つに処理が分かれています。
- 選択セル範囲の現時点の値を配列に格納。
- 配列を並べ替え。
- 並べ替えた配列内容を選択セル範囲に反映。
１つ目と３つ目は選択セル範囲をくるくるループして配列に入れるかセットするかの話なので大したことはやっておらずコメントに書いたままです。
メインは２つ目の配列の並べ替えです。配列の内容を入れ替えているのですが、ぱっと見た感じでは分かりにくいです。これはフィッシャー-イェーツのシャッフルアルゴリズムと言われる並べ替えの手法を採用しており、そのままコード化しています。
配列の並べ替えの詳細については「VBAの配列を偏りなく高速にランダムに並べ替える」をご参照ください。リンク先で紹介しているコードを簡略化したものを上のコードに採用しています。