ここから本文です

VBAで指定されたセルをランダムに並び替え

dai********さん

2012/11/311:52:20

VBAで指定されたセルをランダムに並び替え

いつもお世話になってます。
以下のようなセルがあったとします。

[みかん][80円]
[りんご][120円]
[バナナ][70円]

みかんから70円までをセル選択して、ボタンをおすと
商品と金額を保ったままランダムに並び替えるVBAマクロを作りたいです。

既に同様のことをされてる方がいて、
http://www.excel.studio-kazu.jp/kw/20110701120757.html

このコードを元に実現しようとしてますが、コレクション配列の「次の列」も
一緒に保持するというロジックがわかりません。

どなたかアドバイスいただけますでしょうか。
Execl2003を使用しています。


Private Sub btnRandom_Click()
Dim myRng As Range
Dim i As Integer
Dim myC As New Collection
Dim myC2 As New Collection

For Each myRng In Selection.Cells
myC.Add myRng.Value
Next myRng

ReDim buf(1 To myC.Count)
Randomize
For Each myRng In Selection.Cells
i = Int(myC.Count * Rnd + 1)
myRng.Value = myC.Item(i)
myC.Remove i
Next myRng
End Sub

この質問は、活躍中のチエリアン・専門家に回答をリクエストしました。

閲覧数:
1,548
回答数:
2
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

xls********さん

編集あり2012/11/313:00:46

Resizeすればよいみたいです。

    Dim myRng As Range
    Dim i As Integer
    Dim myC As New Collection
                    
    For Each myRng In Selection.Cells
        myC.Add myRng.Resize(, 2).value
    Next myRng
                    
    ReDim buf(1 To myC.Count)
    Randomize
    For Each myRng In Selection.Cells
        i = Int(myC.Count * Rnd + 1)
        myRng.Resize(, 2).value = myC.Item(i)
        myC.Remove i
    Next myRng

≫追記
セル選択は、[みかん]から [バナナ]の列だけにしてください。

質問した人からのコメント

2012/11/3 13:21:38

抱きしめる こんなに早く回答もらえるとは思いませんでした!
動作確認して問題ありません!ありがとうございました!

ベストアンサー以外の回答

1〜1件/1件中

ipl********さん

編集あり2012/11/313:19:50

ランダムに並び替えるのが目的なら質問のプログラムは不要です。
これで十分ランダムな入れ替えが実現できます。


Sub sample()
Dim lastrow As Long 'A列最終行用
Dim r As Long '注目行用
Dim rr As Long '注目行を挿入するランダムな行用
lastrow = Range("A" & Rows.Count).End(xlUp).Row 'A列最終行
For r = 1 To lastrow '注目行を1から最終行まで
rr = Int(Rnd * lastrow) + 1 '注目行を入れ替えるランダムな行
If rr <> r Then 'もし同じでないなら
Rows(r).Cut '注目行切り取り
Rows(rr).Insert Shift:=xlDown '切り取った行をランダムな行に挿入
End If
Next
End Sub



このプログラムは、

[みかん][80円]
[りんご][120円]
[バナナ][70円]

の場合、
まず1行目をランダムな行に挿入する。
次に2行目をランダムな行に挿入する。
最後に3行目をランダムな行に挿入する。
を実行しています。

Excelの手動作業で言えば、
ある行を切り取り、切り取った行をランダムな行に挿入。
これを全ての行で実行。
になります。




ちなみに、質問のプログラムでは「Selection.Cells」が対象の範囲なので、この場合は

Range("A1:A3").Select

になってなくてはいけないです。
実際のプログラムでは3行目までではなく、A1からA列最終行までの範囲なので、

Range("A1", Range("A" & Rows.Count).End(xlUp)).Select

などになります。
そしてプログラムから推測すると、myCはA列で、myC2がB列の値なのかと思うので下のようになります。

Private Sub btnRandom_Click()
Dim myRng As Range
Dim i As Integer
Dim myC As New Collection
Dim myC2 As New Collection
Range("A1", Range("A" & Rows.Count).End(xlUp)).Select 'A1からA列最終行まで選択
For Each myRng In Selection.Cells
myC.Add myRng.Value 'A列の値を覚える
myC2.Add myRng.Offset(, 1).Value 'B列の値を覚える
Next myRng
ReDim buf(1 To myC.Count)
Randomize
For Each myRng In Selection.Cells
i = Int(myC.Count * Rnd + 1)
myRng.Value = myC.Item(i) 'A列の値を設定
myRng.Offset(, 1).Value = myC2.Item(i) 'B列の値を設定
myC.Remove i 'A列の値を削除
myC2.Remove i 'B列の値を削除
Next myRng
End Sub




ちなみに、ここでは2列なのでmyCとmyC2を使っていますが、Collectionには配列値も設定できるので、myC2を使わずに下のようにもできます。

Private Sub btnRandom_Click()
Dim myRng As Range
Dim i As Integer
Dim myC As New Collection
Range("A1", Range("A" & Rows.Count).End(xlUp)).Select 'A1からA列最終行まで選択
For Each myRng In Selection.Cells
myC.Add myRng.Resize(, 2).Value 'A列とB列(配列値)を保存
Next myRng
ReDim buf(1 To myC.Count)
Randomize
For Each myRng In Selection.Cells
i = Int(myC.Count * Rnd + 1)
myRng.Resize(1, 2).Value = myC.Item(i) 'A列とB列に値をセット
myC.Remove i
Next myRng
End Sub




それと、質問のプログラムがSelectionで処理していたのでSelectしましたが、SelectやSelectionで処理すると、見た目で変化が分かりやすいのですが、画面のちらつきや速度低下などを起こすので、運用するプログラムでは避けた方がいいと思います。

Private Sub btnRandom_Click()
Dim myRng As Range
Dim i As Integer
Dim myC As New Collection
Dim myC2 As New Collection
Dim target As Range '質問のプログラムのSelectionを記憶するための変数
Set target = Range("A1", Range("A" & Rows.Count).End(xlUp)) 'A1からA列最終行まで
For Each myRng In target.Cells 'Selectionを使わない
myC.Add myRng.Value 'A列の値を覚える
myC2.Add myRng.Offset(, 1).Value 'B列の値を覚える
Next myRng
ReDim buf(1 To myC.Count)
Randomize
For Each myRng In target.Cells 'Selectionを使わない
i = Int(myC.Count * Rnd + 1)
myRng.Value = myC.Item(i) 'A列の値を設定
myRng.Offset(, 1).Value = myC2.Item(i) 'B列の値を設定
myC.Remove i 'A列の値を削除
myC2.Remove i 'B列の値を削除
Next myRng
End Sub

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる