EXCEL VBA 配列変数の値すべてを返すには

EXCELは2002ですが、97でも動くと嬉しいです。
《質問》
1～10をランダムに並べるためのプログラムを書きました。
これはこれで動くのですが、一行（3行目）だではなく
4行目にも、5行目にも同じことをしたい場合、
バブルソートの部分をサブルーチン（関数）にしたいのですが
X_v() = GetSortArray(n_s,n_v)()とはできません。.cloneもだめですよね。
かといって、要素毎に引くとその度にRndが効いて、1～10が並びません。
どのようにやるのが、スマートなのでしょうか？よろしくお願いします。
《以下プログラム》
Sub Bu_Click()
Dim i As Integer
Dim j As Integer
Const n_e = 10
Const n_s = 1
Dim X_r(n_e) As Long
Dim X_v(n_e) As Long
Dim temp1 As Long
Dim temp2 As Integer
Randomize
For i = n_s To n_e
X_r(i) = Int(Rnd * 10 ^ 9)
X_v(i) = i
Next i
For i = n_s To n_e - 1
For j = n_s To n_e - 1
If X_r(j + 1) < X_r(j) Then
temp1 = X_r(j + 1)
X_r(j + 1) = X_r(j)
X_r(j) = temp1
temp2 = X_v(j + 1)
X_v(j + 1) = X_v(j)
X_v(j) = temp2
End If
Next j
Next i
For i = 0 To n_e - 1
Cells(3, 3 + i).Value = X_v(i + 1)
Next i
End Sub

Public Function GetSortArray(s As Integer, e As Integer) As Long()
Dim r() As Long
Dim v() As Long
Dim temp1 As Long
Dim temp2 As Integer
ReDim r(e)
ReDim v(e)
Randomize
For i = s To e
r(i) = Int(Rnd * 10 ^ 9)
v(i) = i
Next i
For i = s To e - 1
For j = s To e - 1
If r(j + 1) < r(j) Then
temp1 = r(j + 1)
r(j + 1) = r(j)
r(j) = temp1
temp2 = v(j + 1)
v(j + 1) = v(j)
v(j) = temp2
End If
Next j
Next i
GetSortArray = v()
End Function
ありゃ？Tabのスペース消えますね。

No.1 ベストアンサー 回答者： lotilyxoen 回答日時： 2009/08/21 04:50

質問がちょっと分かりづらいのですが、以下のように変更してみました。

Sub Bu_Click()
Const n_e = 10
Const n_s = 1
Dim X_r() As Long
Dim X_v() As Long

'配列を引数として渡す
Call GetSortArray(n_s, n_e, X_r(), X_v())

For i = 0 To n_e - 1
Cells(3, 3 + i).Value = X_v(i + 1)
Next i
End Sub

Public Sub GetSortArray(s As Integer, e As Integer, r() As Long, v() As Long)
Dim temp1 As Long
Dim temp2 As Integer
ReDim r(e)
ReDim v(e)
Randomize
For i = s To e
r(i) = Int(Rnd * 10 ^ 9)
v(i) = i
Next i
For i = s To e - 1
For j = s To e - 1
If r(j + 1) < r(j) Then
temp1 = r(j + 1)
r(j + 1) = r(j)
r(j) = temp1
temp2 = v(j + 1)
v(j + 1) = v(j)
v(j) = temp2
End If
Next j
Next i
End Sub

あと
For j = s To e - 1
のところは
For j = s To e - i
にした方がちょっとだけ速くなります。

この回答へのお礼

ありがとうございます。
これは97でも動きますね。
助かります。

要素をひとつずつ取り出すプログラムは
作ってみてだめだったのですが、
これ問題ないですね。う～ん、難しいです。

お礼日時：2009/08/21 22:58

No.5 回答者： NNAQ 回答日時： 2009/08/22 23:50

#3 です。

最初の質問の
> バブルソートの部分をサブルーチン（関数）にしたいのですが
> X_v() = GetSortArray(n_s,n_v)()とはできません。

については、

Sub Bu_Click()
Dim i As Integer
Const n_e As Integer = 10
Const n_s As Integer = 1
Dim X_v() As Long

X_v() = GetSortArray3(n_s, n_e)
For i = 0 To n_e - n_s
Cells(3, 3 + i).Value = X_v(i)
Next i
End Sub

↑で、要素をひとつずつ取り出して、動作すると思いますが。


また蛇足ですが、どのアルゴリズムを使うか、というより、
必要なのは　v() だけなので、　r() もソートするのは無駄ではないかと、思いました。
そこで、今度は安定ソートで、、、
'変数はLong型に統一しました。
's As Integer, e As Integer なのに、GetSortArray As Long()なのは何故?
Function GetSortArray3(s As Long, e As Long) As Long()
Dim i As Long, j As Long
Dim r() As Long, v() As Long
Dim temp1 As Long, temp2 As Long

ReDim r(e - s), v(e - s)
Randomize
For i = 0 To e - s
r(i) = Int(Rnd * 10 ^ 9)
v(i) = i + s
Next i

'挿入ソートで、v() をソート、r() はソートしない
For i = 1 To e - s
temp1 = v(i): temp2 = r(temp1 - s)
For j = i - 1 To 0 Step -1
If temp2 >= r(v(j) - s) Then Exit For
v(j + 1) = v(j)
Next j
v(j + 1) = temp1
Next i

GetSortArray3 = v()
Erase r, v
End Function

この回答へのお礼

皆様どうもありがとうございました。
乱数の話や、ソートアルゴリズムに関するご回答も大変参考になりました。
全員には、点数を差し上げられませんので、
大変心苦しいのですが、当初の質問は、関数（サブルーチン）の作り方であったこと。ご回答の順番。97への対応などで選択させて頂きます。
どうもありがとうございました。

お礼日時：2009/08/26 21:01

No.4 回答者： Wendy02 回答日時： 2009/08/22 13:12

こんにちは。

#2の回答者です。

>＞r(i) = Rnd()
>↑これですと、私の環境（2002SP3）では
>1列目に『2や3』10列目に『10』が来る確率が高いです。
>なぜか『1』は真ん中当たり。（注　1～10を表示した場合）

調べてみましたが、確かに、少ない行数ですと、その傾向があるようです。

こちらが以前調べた範囲では、一様乱数に対しても、Rnd 関数は、ほぼ正規分布しているようです。どうも、Randomize の実行数が多すぎると問題が発生する可能性が強いのではないかと思います。ただ、その処置に関しては、お任せします。

資料：

http://support.microsoft.com/kb/828795/ja
Excel 2007 と Excel 2003 の RAND 関数について

http://support.microsoft.com/kb/28150/ja
RND と RANDOMIZE 方法の乱数を生成

実際、Excel 2003/2007に関して、サポートが言うほどに、新乱数生成ジェネレータでも、その乱数発生が完ぺきではないとは思っています。

私個人は、
int(Rnd()*10^9)
決定的なダメ出しがないと、変えられません。Rnd関数の代わりのNT乱数のアドインはあるのですが、それは万民むきではありません。

>e = e - s　'このままでは、－になるとだめですね。人にあげる訳ではないので良いか。

数の間の乱数を作るというなら、コードのが違います。
なお、配列変数は、ひとつにまとめようが、ふたつにしようが、ほとんど変わらないはずです。

'-------------------------------------------

Public Function GetSortArray(ByVal s As Integer, ByVal e As Integer) As Long()
Dim r() As Double
Dim v() As Long
Dim temp1 As Long
Dim temp2 As Integer
If s > e Then temp1 = e: s = e: e = temp1
ReDim r(e - s)
ReDim v(e - s)
Randomize
For i = 0 To e - s
　　r(i) = Rnd()　'お任せします。
　　v(i) = s + i
Next i
For i = 0 To e - s
　　For j = 0 To e - s - 1
　　　　If r(j + 1) < r(j) Then
　　　　　　temp1 = r(j + 1)
　　　　　　r(j + 1) = r(j)
　　　　　　r(j) = temp1
　　　　　　temp2 = v(j + 1)
　　　　　　v(j + 1) = v(j)
　　　　　　v(j) = temp2
　　　　End If
　　Next j
Next i
GetSortArray = v()
End Function

No.3 回答者： NNAQ 回答日時： 2009/08/21 17:05

ランダムシャッフルですね？

Dim X_v() As Long '動的配列にして
X_v() = GetSortArray(n_s, n_e) '最後にカッコ()付けない
これで、ご希望の動作になるでしょう。

蛇足になるかもしれませんが、バブルソートで２つの配列を並び替えるのはスマート(?)ではないでしょう。

選択ソートのアルゴリズムを使って考えてみました。
Sub Bu_Click2()
Const n_e As Integer = 10
Const n_s As Integer = 1

Cells(3, 3).Resize(1, n_e - n_s + 1).Value = GetSortArray2(n_s, n_e)
'縦に出力する場合↓
'Cells(3, 3).Resize(n_e - n_s + 1).Value = WorksheetFunction.Transpose(GetSortArray2(n_s, n_e))

End Sub

Function GetSortArray2(s As Integer, e As Integer) As Integer()
Dim i As Integer, j As Integer, k As Integer
Dim r() As Long, v() As Integer
Dim temp1 As Long, temp2 As Integer

ReDim r(s To e), v(s To e)
Randomize
For i = s To e
r(i) = Int(Rnd * 10 ^ 9)
v(i) = i
Next i

For i = s To e - 1
temp1 = r(i): k = i
For j = i + 1 To e
If temp1 > r(j) Then
temp1 = r(j): k = j
End If
Next j
r(k) = r(i)
temp2 = v(k): v(k) = v(i): v(i) = temp2
Next i

GetSortArray2 = v()
End Function

この回答へのお礼

ありがとうございます。
10個しかないので、バブルでもいいかなと思ったんですが
参考にします。

http://ja.wikipedia.org/wiki/%E3%82%BD%E3%83%BC% …
ここで不安定と書いてあったので
あっ、備考みてなかった。

お礼日時：2009/08/21 23:05

No.2 回答者： Wendy02 回答日時： 2009/08/21 09:23

こんにちは。

ご自身が書いたコードではないのでしょうか。

良く分からないところがありますね。
>r(i) = Int(Rnd * 10 ^ 9)

Excel2002以下の乱数ジェネレータは精度が低いので、そのまま一様乱数をそのまま、Double 型で入れても良いと思うのですが、何か問題があったのでしょうか？

それと、もともと、Option Base 1 を使えばよいのですが、そうでないなら、配列変数の添え字を0から使ってもよいと思います。

Sub Bu_Click()
　　Dim i As Long
　　Dim ret As Variant
　　Const iST As Integer = 1
　　Const iED As Integer = 10
　　
　　For i = 1 To 5　'5行出力
　　　'縦に出力する可能性があるので変数ret を使う
　　　　ret = GetSortArray(iST, iED)　　　　
　　　　Cells(3 + i, 4).Resize(, UBound(ret) + 1).Value = ret
　　Next i
End Sub


Public Function GetSortArray(ByVal s As Integer, ByVal e As Integer) As Long()
Dim r() As Double
Dim v() As Long
Dim temp1 As Long
Dim temp2 As Integer
e = e - 1: s = s - 1　'0からに換える
ReDim r(e)
ReDim v(e)
Randomize
For i = s To e
　　r(i) = Rnd()
　　v(i) = i
Next i
For i = s To e
　　For j = s To e - 1
　　　　If r(j + 1) < r(j) Then
　　　　　　temp1 = r(j + 1)
　　　　　　r(j + 1) = r(j)
　　　　　　r(j) = temp1
　　　　　　temp2 = v(j + 1)
　　　　　　v(j + 1) = v(j)
　　　　　　v(j) = temp2
　　　　End If
　　Next j
Next i
GetSortArray = v()
End Function

この回答への補足

＞Dim ret As Variant
＞ ret = GetSortArray(iST, iED)
＞ Cells(3 + i, 4).Resize(, UBound(ret) + 1).Value = ret
回答ありがとうございます。
↑こう書くものなのですね。ResizeとかUBoundとか初めて目にしました。
年に1回くらいしかVBA組まないので。（配列自体ほとんど使わない）

回答を参考に少し修正して、初期の目的を達成しました。ありがとうございます。


＞r(i) = int(Rnd()*10^9)
この方がランダム性が良い気がします。（なんとなくですが）

＞r(i) = Rnd()
↑これですと、私の環境（2002SP3）では
1列目に『2や3』10列目に『10』が来る確率が高いです。
なぜか『1』は真ん中当たり。（注　1～10を表示した場合）



《下記は、1～10だけでなく、2～11などにも対応》
Public Function GetSortArray(ByVal s As Integer, ByVal e As Integer) As Long()

Dim r() As Long
Dim v() As Long
Dim temp1 As Long
Dim temp2 As Integer
e = e - s　'このままでは、－になるとだめですね。人にあげる訳ではないので良いか。
ReDim r(e)
ReDim v(e)
Randomize
For i = 0 To e
r(i) = int(Rnd()*10^9)
v(i) = i + s
Next i
For i = 0 To e - 1
For j = 0 To e - 1
If r(j + 1) < r(j) Then
temp1 = r(j + 1)
r(j + 1) = r(j)
r(j) = temp1
temp2 = v(j + 1)
v(j + 1) = v(j)
v(j) = temp2
End If
Next j
Next i
GetSortArray = v()
End Function

補足日時：2009/08/21 22:17