マクロでセルをランダムに並び替えたい

質問

マクロ初心者です。
Sheet1のB4に１、B1003に１０００　というように整数が小さい順番にセルに入力してあり、
Sheet2のB4からB1003までにそれらのセルをランダムに並べ換え、
さらにそれらのセルをSheet3のB4からB1003に大きい順（B4に１０００、B1003に1といったように）に並び替えたいのですが、
どうすればいいでしょうか。

Sub 並び替え()
Dim RndArr(999, 0) As Variant
Dim i As Integer, c As Integer
Dim rndTmp As Integer
Randomize
i = 0

RndArr(i, 0) = Int(1000 * Rnd) + 1
Do
Re:
rndTmp = Int(1000 * Rnd) + 1
For c = 0 To i
If rndTmp = RndArr(c, 0) Then GoTo Re
Next c
i = i + 1
RndArr(i, 0) = rndTmp
Loop Until i > 999

Range("b4.Sheet2", "b1003.Sheet2") = RndArr
End Sub

今わかっている状況は上記の通りですが、
このマクロだと、セルを並び替えているのではなく乱数を当てはめているだけなので、
整数が重複してしまいます。
よろしくお願いします。

回答No.1

noname#215107 · ベストアンサー

こんばんは。
トランプをくる要領で、並び替えを行ってみました。

　Private Sub 並び替え()
　　　Dim i As Integer
　　　Dim m As Variant
　　　Dim r As Integer
　　　'Ｓｈｅｅｔ１をＳｈｅｅｔ２にコピー
　　　For i = 1 To 1000
　　　　　Worksheets("Sheet2").Cells(i + 3, 2) = Worksheets("Sheet1").Cells(i + 3, 2)
　　　Next i

　　　With Worksheets("Sheet2")
　　　　　'Ｓｈｅｅｔ２をランダムに並び替え
　　　　　For i = 1 To 1000
　　　　　　　m = .Cells(i + 3, 2)
　　　　　　　r = Int(Rnd * 1000) + 1
　　　　　　　.Cells(i + 3, 2) = .Cells(r + 3, 2)
　　　　　　　.Cells(r + 3, 2) = m
　　　　　Next i
　　　　　'降順に並び替えてＳｈｅｅｔ３へ
　　　　　For i = 1 To 1000
　　　　　　　Worksheets("Sheet3").Cells(1001 - .Cells(i + 3, 2) + 3, 2) = .Cells(i + 3, 2)
　　　　　Next i
　　　End With
　End Sub

お礼

ありがとうございます。
無事に解決いたしました。

回答No.2

noname#215107

Ｎｏ．１です。補足します。
Ｓｈｅｅｔ３への降順の並び替えは、ご質問の条件の時だけに適用できます。１～１０００以外のデータも含まれる場合は、バブルソートやクイックソート等の教科書どおりの手法を使ってください。