Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2782 / 13645 ツリー ←次へ | 前へ→

【66008】ランダムに数字を振り分けたいんですが ogi 10/7/15(木) 2:40 質問[未読]
【66009】Re:ランダムに数字を振り分けたいんですが 通りすがり 10/7/15(木) 2:55 発言[未読]
【66010】Re:ランダムに数字を振り分けたいんですが SS 10/7/15(木) 10:59 発言[未読]
【66019】早速のご教授真に有り難うございました ogi 10/7/15(木) 22:54 お礼[未読]

【66008】ランダムに数字を振り分けたいんですが
質問  ogi  - 10/7/15(木) 2:40 -

引用なし
パスワード
   ランダムに数字を振り分けて、各列で指定のそれぞれの数字の数を指定して振り分けたいのですが、下記のようなバラバラに振り分けるのではなくA列の3・4を3を4つ、4を3つという感じに条件付けたいんですが可能でしょうか?
A B C D E F
3 1 3 0    4 0
3 2 3 1    3 1
3 2 3 2 4 2
3 0 3 1    4 1
4 1 3 0    4 1
3 1 3 1    3 1
4 1 3 0 3 0

因みに、勤務表を自動で作成するのが最終目的です。
自分で作成したのを載せておきます。
----------------------------------------------------
Sub サンプル()

Dim intMax As Integer
Dim intMin As Integer
Dim i As Integer
Dim k As Integer

intMax = 4
intMin = 3

Randomize

For i = 1 To 10
For k = 0 To 4 Step 2
For R = 7 To 12 Step 2
For t = 15 To 20 Step 2
For s = 23 To 28 Step 2
Cells(i + 1, k + 1) = Int((intMax - intMin + 1) * Rnd + intMin)
Cells(i + 1, R + 1) = Int((intMax - intMin + 1) * Rnd + intMin)
Cells(i + 1, t + 1) = Int((intMax - intMin + 1) * Rnd + intMin)
Cells(i + 1, s + 1) = Int((intMax - intMin + 1) * Rnd + intMin)
Next s
Next t
Next R
Next k
Next i


intMax = 2
intMin = 0

Randomize

For i = 1 To 10
For k = 1 To 5 Step 2
For R = 8 To 13 Step 2
For t = 16 To 21 Step 2
For s = 24 To 29 Step 2
Cells(i + 1, k + 1) = Int((intMax - intMin + 1) * Rnd + intMin)
Cells(i + 1, R + 1) = Int((intMax - intMin + 1) * Rnd + intMin)
Cells(i + 1, t + 1) = Int((intMax - intMin + 1) * Rnd + intMin)
Cells(i + 1, s + 1) = Int((intMax - intMin + 1) * Rnd + intMin)
Next s
Next t
Next R
Next k
Next i

End Sub
-------------------------------------------------
もっとスマートなのがあれば手直しお願いいたします。

【66009】Re:ランダムに数字を振り分けたいんですが
発言  通りすがり  - 10/7/15(木) 2:55 -

引用なし
パスワード
   これはやばいね
Cells(i + 1, k + 1) を64回ぐらい書き換えてる

【66010】Re:ランダムに数字を振り分けたいんですが
発言  SS  - 10/7/15(木) 10:59 -

引用なし
パスワード
   ▼ogi さん:

こんにちは、やりたいことが良く分かりませんがこんなことでしょうか?
ただし全てをランダムでと言うのはいかがなものかと感じます。
基本動作があっていれば条件を追加して応用してみてください。
※IF文を使わなかったので面倒くさいことになっているかもしれません。

Sub test()
  Dim Data(2, 10) As Variant  '参照データ用
  Dim dat(2, 3, 2) As Variant '制御用
  Dim SetD(10) As Variant, TmpD As Variant '参照場所決定用
  Dim i As Integer, j As Integer, k As Integer, m As Integer
  Dim Gr As Integer, Cl As Integer, XX As Integer '複数表作成用
  
  Randomize
  
  '第1グループの分割
  dat(1, 1, 1) = 6
  dat(1, 2, 1) = 4
  '第2グループの分割
  dat(2, 1, 1) = 5
  dat(2, 2, 1) = 3
  dat(2, 3, 1) = 2
  
  '第1グループの要素
  dat(1, 1, 2) = "田中" '4
  dat(1, 2, 2) = "鈴木" '3
  '第2グループの要素
  dat(2, 1, 2) = "橋本" '2
  dat(2, 2, 2) = "山田" '1
  dat(2, 3, 2) = "加藤" '0
  
  '各グループの要素の格納
  For i = 1 To 2
    m = 0
    For j = 1 To 3
      For k = 1 To dat(i, j, 1)
        m = m + 1
        Data(i, m) = dat(i, j, 2)
      Next k
    Next j
  Next i
  
  For i = 1 To 10
    SetD(i) = i
  Next i
  
  For Gr = 0 To 3
    For Cl = 0 To 5
      XX = Cl Mod 2 + 1
      TmpD = SetD
      j = 10
      For i = 1 To 10
        k = Int(Rnd * j) + 1
        Cells(i + 1, Gr * 8 + Cl + 1).Value = Data(XX, TmpD(k))
        For m = k To j - 1
          TmpD(m) = TmpD(m + 1)
        Next m
        j = j - 1
      Next i
    Next Cl
  Next Gr
End Sub

【66019】早速のご教授真に有り難うございました
お礼  ogi  - 10/7/15(木) 22:54 -

引用なし
パスワード
   ▼SS さん:
質問文が分かりにくいにもかかわらず返信していただきありがとうございます。
思いどうりの物ができそうです。

本当にありがとうございました。

また分からないことがあれば質問させていただきます。

2782 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free