ランダム並べ替えを複数列で実行するには？

私はマクロ自動登録が出来る程度の初心者です
以前ここに掲載されたマクロを拝借させて頂きました、下記がそうです
R5：R520までの数値をランダムに並べ替えるものですが、
これを、R, S, T, U…１００列まで実行したいのですが何度試しても出来ません
どうぞよろしくお願い致します
Sub Sample2()
　　Dim Dat As Variant, Tmp As Variant
　　Dim i As Integer, j As Integer
　　Randomize
　　Dat = Range("R5:R520").Value
　　For i = 516 To 2 Step -1
　　If IsNumeric(Dat(i, 1)) And Dat(i, 1) <> "" Then
　　Do
　　j = Int(Rnd * i + 1)
　　Loop Until IsNumeric(Dat(j, 1)) And Dat(j, 1) <> ""
　　Tmp = Dat(i, 1): Dat(i, 1) = Dat(j, 1): Dat(j, 1) = Tmp
　　End If
　　Next i
　　Range("R5:R520").Value = Dat
End Sub

質問者からの補足コメント

• 私が未熟なせいか、実行したら１列目(A5)から並べ替えが実行され
  マクロ編集画面で確認したら、列挙した列記号が赤色になっていました
  大変申し訳ありませんが、助言お願い致します

  No.1の回答に寄せられた補足コメントです。 補足日時：2016/01/22 16:34

No.2 ベストアンサー 回答者： bonaron 回答日時： 2016/01/22 16:14

ちょっとだけスマートに。

Sub Sample2()
　　Dim Dat As Variant, Tmp As Variant
　　Dim i As Integer, j As Integer, k As Integer
　　Dim rng As Range
　　Randomize
　　For k = 18 To 100　　' R列 から CV列まで
　　　　Set rng = Rows("5:520").Columns(k)
　　　　Dat = rng.Value
　　　　For i = 516 To 2 Step -1
　　　　　　If IsNumeric(Dat(i, 1)) And Dat(i, 1) <> "" Then
　　　　　　　　Do
　　　　　　　　　　j = Int(Rnd * i + 1)
　　　　　　　　Loop Until IsNumeric(Dat(j, 1)) And Dat(j, 1) <> ""
　　　　　　　　Tmp = Dat(i, 1): Dat(i, 1) = Dat(j, 1): Dat(j, 1) = Tmp
　　　　　　End If
　　　　Next i
　　　　rng.Value = Dat
　　Next
End Sub


確認ですが、列内で並べ替えるのを
R列 から CV列 まで繰り返す、ということでよろしいですね。

R5 から CV520 までをぐちゃぐちゃに、ということではありませんね？

この回答へのお礼

有難うございます
早速、実行させて頂きます　感謝致します
R列～DM列までと考えています

お礼日時：2016/01/22 17:20

No.1 回答者： t_fumiaki 回答日時： 2016/01/22 13:35

自動でやるんだったら、少し泥臭いけど以下（動作確認済み）

Sub Sample2()
Const 列文字 As String = "R S T U V W X Y Z AA" ←列記号を列挙
Dim 列カウンタ As Integer
Dim 列 As String


Dim Dat As Variant, Tmp As Variant
Dim i As Integer, j As Integer

For 列カウンタ = 1 To 10　 ←列の数分回す
列 = Mid(列文字, (列カウンタ - 1) * 2 + 1, 2)　←対象列抽出
列 = Trim(列)　←空白削除

Randomize
Dat = Range(列 & "5:" & 列 & "520")　←列範囲を作成

For i = 516 To 2 Step -1
If IsNumeric(Dat(i, 1)) And Dat(i, 1) <> "" Then
Do
j = Int(Rnd * i + 1)
Loop Until IsNumeric(Dat(j, 1)) And Dat(j, 1) <> ""
Tmp = Dat(i, 1): Dat(i, 1) = Dat(j, 1): Dat(j, 1) = Tmp
End If
Next i

Range(列 & "5:" & 列 & "520") = Dat　←列範囲を指定

Next 列カウンタ

End Sub

この回答へのお礼

早速のお答え、ご指示有難うございます
まだ実行して見てませんが直ぐに取り掛かります

お礼日時：2016/01/22 14:03