| |
こんにちは。
仕事で投稿できませんでした。
まず、訂正から・・・・。
>例えば簡単な例で
> A校 3人
> B校 2人
> C校 1人
>だとして（問題は3人以上ですが、例を簡単にすると）、
>乱数で
>最初にC校、次にB校が選ばれてしまうと、
>A校が連続してしまいますよね！！
これ、最初にB校、次にC校、その次にB校が選ばれてしまうと、
>A校が連続してしまいますよね！！
でした。
で、・・・・。
>>>出来ているコードは、提示してください。
私は、当初Collectionオブジェクトを使っているのかなあ なんて想像していましたが、
Excelらしい方法ですねえ！！
>
> 今職場に来て、確認してみると、
> A校2人、B校5人 C校3人 D校4人 E校3人 F校3人 G校10人の計30人でした。
では、サンプルデータを↑に倣って作成してみましょう。
新規ブックにて、標準モジュールに
'================================================================
Sub sample1()
With ActiveSheet
.Range("a1:c1").Value = Array("NO", "氏名", "校名")
With .Range("a2:a31")
.Formula = "=row()-1"
.Value = .Value
End With
With .Range("b2:b26")
.Formula = "=rept(char(63+row()),3)"
.Value = .Value
End With
With Range("b27:b31")
.Formula = "=char(38+row())&char(38+row()+1)&char(38+row()+2)"
.Value = .Value
End With
With .Range("c2:c31")
.FormulaArray = Evaluate("{""A校"";""A校"";""B校"";""B校"";""B校"";""B校"";""B校"";" & _
"""C校"";""C校"";""C校"";""D校"";""D校"";""D校"";""D校"";""E校"";""E校"";" & _
"""E校"";""F校"";""F校"";""F校"";""G校"";""G校"";""G校"";""G校"";""G校"";" & _
"""G校"";""G校"";""G校"";""G校"";""G校""}")
.Value = .Value
End With
End With
End Sub
上記のsample1を実行してみてください。
A列からC列に サンプルデータが作成されます。
このサンプルデータに対して、同じ学校が連続しないように並べ替えます。
別の標準モジュールに
'=====================================================================
Sub test1()
Dim rng1 As Range
Dim rng2 As Range
With ActiveSheet
Set rng1 = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
With rng1
If .Row > 1 Then
Set rng2 = .Offset(0, 2)
With .Offset(0, 3).Resize(, 2)
.Offset(-1, 0).Rows(1).Value = Array("t1", "t2")
.Formula = Array("=RAND()", "=COUNTIF(" & rng2.Address & ",c2)")
.Value = .Value
End With
.Parent.Range("a1").Sort Key1:=Range("E2"), Order1:=xlDescending, Key2:=Range("C2") _
, Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal, DataOption3:=xlSortNormal
Set rng2 = .Offset(0, 4)
With .Offset(0, 5)
.Offset(-1, 0).Cells(1).Value = "t4"
.Formula = "=mod(row(),max(" & rng2.Address & "))"
.Value = .Value
End With
.Parent.Range("a1").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End If
End With
.Range("d:f").ClearContents
End With
Set rng1 = Nothing
Set rng2 = Nothing
End Sub
上記test1を実行してみてください。
同じ学校は、連続しないように並べられると思います。
尚、D,E,F列は、作業列として、プログラムが使っています。
実際には、D,E列にもデータが入っているとしたら、作業列を移動しなければ
なりませんが、それはご自分で考えてみてください。
>
> 自分が理解できる範囲で、乱数関数を入れて昇順でならべかえました。
>
>
>>>別のアルゴリズムも必要ですね！！
>
> どのように、考えていけばいいのかわからない状態です。
> 教えていただけると、大変ありがたいです。
> よろしくお願いいたします。
>
>
>Sub 乱数の発生()
>
>Application.ScreenUpdating = False
>
> '名簿最終行の確認
> Dim i As Integer
> i = 3
> Do While Cells(i, 3) <> ""
> i = i + 1
> Loop
>
> '乱数の発生
> Range("K3").Formula = "=RAND()"
> Range("K3").Copy
> Range(Cells(4, 11), Cells(i - 1, 11)).PasteSpecial
>
> '関数を値のみ貼り付けて、値を固定する
> Range(Cells(3, 11), Cells(i - 1, 11)).Copy
> Range("K3").PasteSpecial Paste:=xlValues
>
>
> '乱数の昇順で並べ替え
> Range(Cells(3, 2), Cells(i - 1, 11)).Select
> Range(Cells(3, 2), Cells(i - 1, 11)).Sort _
> key1:=Range("K3"), order1:=xlAscending
>
> '乱数関数の列のクリア
> Range("K3:K32").ClearContents
> Range("A1").Select
>
> ' スクロール列の設定
> ActiveWindow.ScrollColumn = 2
> ' スクロール行の設定
> ActiveWindow.ScrollRow = 1
>
>Application.ScreenUpdating = True
>
>End Sub
|
|
ichinose
- 11/7/20(水) 17:42 -
