- ベストアンサー
VBAでランダムな並び替えをするには
mitarashiの回答
- mitarashi
- ベストアンサー率59% (574/965)
40個の数字から、ランダムに、重複無く抜き出して、かつ抜き出した数字のセルは空白にしたいという事でしょうか。 「重複無く」実現のために、エクセルの機能を活かした作業行を別シートに設けるのはいかがでしょうか。 Sub test() For i = 1 To 40 Cells(1, i) = i: Cells(3, i) = "" Sheets(2).Cells(1, i) = i Next i For i = 1 To 40 MsgBox (Str(40 - i + 1) & "枚から1枚選びます") x = Int(Rnd() * (40 - i + 1)) + 1 Cells(3, i).Value = Sheets(2).Cells(1, x).Value Cells(1, Sheets(2).Cells(1, x).Value).Value = "" MsgBox ("確認して下さい") Sheets(2).Cells(1, x).Delete Shift:=xlToLeft Next i End Sub
関連するQ&A
- VBAの乱数について質問
乱数 x (0<x<1)を0.1刻みで発生させたいんですが うまくいきません。 プログラム例 Sub 一様乱数() Dim bin#(10) n = 1000 For m = 1 To 10 bin#(m) = 0 Next m For J = 1 To n x = Rnd(1) ix = Int(10 * Rnd(1)) bin#(ix) = bin#(ix) + 1 Next J Cells(4, 1) = " I" Cells(4, 2) = "Bin#(I)度数分布" For I = 0 To 10 Cells(I + 5, 1).Value = I Cells(I + 5, 2).Value = bin#(I) Next I End Sub ここで、9行目ix = Int(10 * Rnd(1))で0.1刻みになり 15行目のFor I = 0 To 10を0 to 1に変えればできると思ったんですが できませんでした。 どこが問題なのかヒントでもいいので教えてください。
- 締切済み
- Visual Basic
- Visual Basicで単語帳をつくりたい
こんにちは！Visual Basicを使って単語帳をつくらなければならいのですが、作り方がさっぱりです。 現在このような感じになっていて実行ができないのですが どうすればいいのでしょうか？ 単語は６つあります。 Sub French2() For I = 1 To 6 X = Int(Rnd * 4) + 1 Z = Cells(X, 1) + "は?" Y = InputBox(Z) If Y = Cells(X, 2) Then Z = "当たり!" MsgBox (Z) Next For I = 5 To 6 X = Int(Rnd * 5) + 6 Z = Cells(X, 1) + "は？" Y = InputBox(Z) If Y = Cells(X, 2) Then Z = "その調子！" Else Z = "残念！" MsgBox (Z) End If End Sub さらに工夫を施さなければならないのですが本当に分らないので困っています。回答お願いします！
- ベストアンサー
- その他MS Office製品
- VBAにおける、たし算の自動作問プログラムについて
二列目に、二桁の整数の足し算を出題することができるたし算の作問プログラムを以下のように作ったのですが、続いて三列目に、足し算の解答をして、それの正誤を確かめるプログラムを作りたいのですがどのようにすればよいでしょうか？ ↓作問のプログラム Sub test() Columns("B:F").Clear n = InputBox("問題数は？") ReDim ans(n) For i = 1 To n Randomize x = Int(Rnd * 100) Randomize y = Int(Rnd * 100) ans(i) = x + y Cells(i, 2) = "(" & i & ") " & x & " + " & y & " = " Next i End Sub 以下のような感じで採点のプログラムを作りたいのですが、上のプログラムの変数ans(i)を参照する場合、下のプログラムのans(i)はどのように定義すればよいのでしょうか？ Sub saiten() For i = 1 To n If Cells(i, 3) = ans(i) Then Cells(i, 4) = "○" Else: Cells(i, 4) = "×" Next i End Sub
- ベストアンサー
- オフィス系ソフト
- 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のスペース消えますね。
- ベストアンサー
- その他MS Office製品
- VBA セルの値を取得する
下記のはランダムにチーム分けするものです。 TmCnt = 5がチーム数です。 Sub Sample() Dim Total As Integer Dim TmCnt As Integer Dim Data1 As Variant Dim Data2() As String Dim i As Integer, j As Integer, k As Integer Total = Cells(Rows.Count, 1).End(xlUp).Row TmCnt = 5 Data1 = Range("A1:A" & Total).Value ReDim Data2(1 To Total) Randomize For i = TmCnt To 1 Step -1 j = Int(Rnd * i) + 1 Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i For i = Total To TmCnt + 1 Step -1 j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1) Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i i = 1 Do For j = 1 To TmCnt k = k + 1 Cells(i, j + 2).Value = Data2(k) If k = Total Then Exit Sub Next j i = i + 1 Loop End Sub TmCnt = 5をセル「B1」にチーム数を入力し、（例「6」「4」など）マクロを実行したいのです。 検索しましたところ、 セルの値を取得するにはRange("A1").Valueを入力だそうです。 TmCnt = 5を下記に書き換えるにはどのようにしたら良いでしょうか？ Dim s As String s = Range(“B1”).Value Debug.Print(s) 宜しくお願いします。
- ベストアンサー
- Visual Basic
- VBA A1をA2に変更したい
またお世話になります。 下記のはランダムにチーム分けするものです。 TmCnt = 5がチーム数です。 これはA1から氏名を読み取り、C1からランダムに表を作成するものです。 A2、C2に変更したいのです。 Data1 = Range("A1:A" & Total).Value A1をA2に変えましたが、「インテックスが有効範囲にありません」とエラーメッセージが出ます。 どこが違うのでしょうか？ 宜しくお願いします。 Sub Sample() Dim Total As Integer Dim TmCnt As Integer Dim Data1 As Variant Dim Data2() As String Dim i As Integer, j As Integer, k As Integer Total = Cells(Rows.Count, 1).End(xlUp).Row TmCnt = 5 Data1 = Range("A1:A" & Total).Value ReDim Data2(1 To Total) Randomize For i = TmCnt To 1 Step -1 j = Int(Rnd * i) + 1 Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i For i = Total To TmCnt + 1 Step -1 j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1) Data2(i) = Data1(j, 1) Data1(j, 1) = Data1(i, 1) Next i i = 1 Do For j = 1 To TmCnt k = k + 1 Cells(i, j + 2).Value = Data2(k) If k = Total Then Exit Sub Next j i = i + 1 Loop End Sub
- ベストアンサー
- Visual Basic
- VBA For～Next
「wsData」の値を「wsInv」の指定セル(=●●●＝16)から４つおきに処理したい。 01：Cells(16 + i * 4, 1) とすると「i」が大きいときに 「""」があると16からスタートしない 02：「For k = 0 To 50」を作成したが、何処に入れても上手く処理出来ない。 For i = 0 To 50 '行 For j = 6 To 28 '列 If wsData.Cells(10 + i, 3).Value = "" Then wsInv.Cells(●●●, 1).Value = wsData.Cells(10 + i, 1).Value wsInv.Cells(●●●, j - 2).Value = wsData.Cells(10 + i, 23 + j).Value End If Next j Next i お力添えをお願いいたします。
- ベストアンサー
- Visual Basic
- Excel2007VBAのランダム置換ソース
Excel（エクセル）2007VBAを使って、 「複数ある、同一の置換したい文字・数」 を 「複数の文字・数」 でランダムに置換したいのですが、 VBAソースが分かりません。 たとえば、 【A列】に A1:私は(置換する所)と(置換する所)が得意です。 A2:彼は(置換する所)と(置換する所)と(置換する所)が特技です。 A3:彼女は(置換する所)と(置換する所)と(置換する所)と(置換する所)の選手です。 A4:彼らは(置換する所)と(置換する所)と(置換する所)と(置換する所)と(置換する所)が好きです。 A5:あの人は(置換する所)と(置換する所)と(置換する所)と(置換する所)と(置換する所)と(置換する所)をしたことがありません。 と入力されている時に、 【B列】に B1:拳闘 B2:柔道 B3:野球 B4:籠球 B5:打球 B6:羽球 B7:剣道 B8:卓球 B9:水泳 B10:避球 と入力したとします。 そして、コマンドボタンを押すと 【A列】にあるすべての 「(置換する所)」 を、 【B列】にある「拳闘」「柔道」「野球」「籠球」「打球」「羽球」「剣道」「卓球」「水泳」「避球」のどれかで必ず置換されるようにします(【ランダムで置換】されるようにしたいです)。 ※置換の条件として、一つのセル内で同じ文字が重複しないようにしたいです。 (私は拳闘と拳闘が得意です。) ↑ ↑ 同じ文字が2つ以上ある置換は失敗です。 --------------------------------- 置換の成功例 (重複なしの置換) ◆置換前の【A列】A5 あの人は(置換する所)と(置換する所)と(置換する所)と(置換する所)と(置換する所)と(置換する所)をしたことがありません。 ↓↓↓ ◆置換後の【A列】A5 あの人は打球と柔道と水泳と剣道と避球と拳闘をしたことがありません。 --------------------------------- これが未完成のVBAソースです。 ↓↓↓ Sub test_Click() For Each CellA In Range("A1:A5").Cells Rnd1 = Int(Rnd() * 10) + 1 Rnd2 = Int(Rnd() * 9) + 1 Rnd3 = Int(Rnd() * 8) + 1 Rnd4 = Int(Rnd() * 7) + 1 Rnd5 = Int(Rnd() * 6) + 1 Rnd6 = Int(Rnd() * 5) + 1 If Rnd2 = Rnd1 Then Rnd2 = Rnd2 + 1 If Rnd3 = Rnd2 Then Rnd3 = Rnd3 + 1 If Rnd4 = Rnd3 Then Rnd4 = Rnd4 + 1 If Rnd5 = Rnd4 Then Rnd5 = Rnd5 + 1 If Rnd6 = Rnd5 Then Rnd6 = Rnd6 + 1 CellA.Value = Replace(CellA, "(置換する所)", Cells(Rnd1, 2), , 1) CellA.Value = Replace(CellA, "(置換する所)", Cells(Rnd2, 2), , 1) CellA.Value = Replace(CellA, "(置換する所)", Cells(Rnd3, 2), , 1) CellA.Value = Replace(CellA, "(置換する所)", Cells(Rnd4, 2), , 1) CellA.Value = Replace(CellA, "(置換する所)", Cells(Rnd5, 2), , 1) CellA.Value = Replace(CellA, "(置換する所)", Cells(Rnd6, 2), , 1) Next End Sub 【補足】 ※コマンドボタンを押すとランダム置換される仕様です。 ※１回限定の置換ではなく、コマンドボタンを押すたびに(何度でも)ランダム置換できるようにしたいです。 ※上記の【A列】【B列】の文字はあくまで例です。実際は、【A列】【B列】ともに自由に文字を変更できる応用の利く仕様にしたいです(Excelの【A列】【B列】に、文字を直接入力して変更するという意味です)。 ※上記の【A列】が5行、【B列】が10行というのもあくまで例です。実際は、【A列】【B列】ともに何行にでも対応できる仕様にしたいです(具体的には【A列】【B列】ともに、10000行くらいまで対応できるのが理想です)。 長くなりましたが、ここまでの条件を満たすVBAソースが知りたいです。 どうかよろしくおねがいいたします。
- ベストアンサー
- その他MS Office製品
- EXCEL VBA2010 MsgBox
Sub 重複() Dim i As Long, j As Long For i = 6 To 500 For j = 3 To 3 If WorksheetFunction.CountIf(Range("C6:C500"), Cells(i, j)) > 1 Then Cells(i, j).Interior.ColorIndex = 6 End If Next j Next i End Sub このVBAに重複が何件ありますよというメッセージを出したいです。 MsgBoxの入れ方を教えてください。
- ベストアンサー
- Excel（エクセル）
- 1から9までの数値をランダムに発生させたい
●質問の主旨 INT関数及びRND関数を使い、「0から9」までの 数値をランダムに発生させるのではなく、「1から9」 までの数値をランダムに発生させるには、下記のコードを どのように書き換えれば良いでしょうか？ ●質問の補足 下記コード及び画像のように九九の計算問題を 作成したいと思っています。今のコードでは 「0から9」までの数値が発生するのは、分かっていたので If ThenステートメントやSelect Caseステートメントを 使って、0の数値が発生するときは「1」とみなすというような 記述もしてみましたが、上手くいきませんでした。 ご存知のかたよろしくお願いします。 なお使用機種はWindowsVista、Excel2007を使用しています。 私はVBAをはじめて3カ月程度です。 ●コード Option Explicit Const ORG_RW As Integer = 4 '問題の開始行 Const DST_RW As Integer = 8 '問題の終了行 Const NUM1_CLM As Integer = 1 '問題の数値1の列 Const NUM2_CLM As Integer = 3 '問題の数値2の列 Const ANSW_CLM As Integer = 5 '問題の解答の列 Private Sub CommandButton1_Click() 'Checkボタン Dim i As Integer 'カウンタ変数 For i = ORG_RW To DST_RW'問題の開始行から問題の終了行まで If Cells(i, NUM1_CLM).Value * Cells(i, NUM2_CLM).Value = Cells(i, ANSW_CLM).Value Then Cells(i, ANSW_CLM).Font.Color = vbBlue '問題が正解のときは文字が青色 Else Cells(i, ANSW_CLM).Font.Color = vbRed '問題が正解のときは文字が赤色 End If Next i End Sub Private Sub CommandButton2_Click() 'Resetボタン Dim i As Integer 'カウンタ変数 For i = ORG_RW To DST_RW Cells(i, ANSW_CLM).ClearContents '解答が消去される Cells(i, ANSW_CLM).Font.Color = vbBlack '解答が消去されたときは文字が黒色 ' 解答が消去されたときは0～9までのランダムな数値が発生 Cells(i, NUM1_CLM).Value = Int(Rnd * 10) '解答が消去されたときは0～9までのランダムな数値が発生 Cells(i, NUM2_CLM).Value = Int(Rnd * 10) Next i End Sub
- ベストアンサー
- Visual Basic
補足
くじを引くたびに１枚ずつくじが減っていく中からランダムにくじを引く状況をシートの上で実現するイメージなんですが。 sheet1だけでできないでしょうか。