[[20250426113105]]　『指定範囲内でランダムに入力』（タカ）　ページの最後に飛ぶ

『指定範囲内でランダムに入力』（タカ）

A2〜A20セルを選択しその中でランダムに早、遅、夜、日を1個ずつ入力される
VBAのコードはどの様に書けば良いですか？
ご回答宜しくお願い致します

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

一案ですが
配列に格納して、要素数の間で乱数を作り、その乱数で要素を取得し
必要な個数分ループ回せば、出来る
と
思いますです。　。。。m(__)m
（隠居Z） 2025/04/26(土) 12:36:17

 Public Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
 Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Option Explicit
Sub OneInstanceMain()
    Dim i As Long
    Dim v(), vAr, oLdKey
    Rnd 20
    v = Array("早", "遅", "夜", "日")
    oLdKey = v(UBound(v))
    With Worksheets("Sheet1")
        .Activate
        Do
            For Each vAr In .Range("A2:A20")
                Do
                    vAr.Value = v(Int((UBound(v) - LBound(v) + 1) * Rnd - LBound(v)))
                    If oLdKey <> vAr.Value Then Exit Do
                    DoEvents
                Loop
                oLdKey = vAr.Value
                vAr.Activate
                Sleep (100)
                If GetAsyncKeyState(27) Then Exit Sub
            Next
            DoEvents
        Loop
    End With
End Sub
他にも条件が有れば、別途工夫が必要です。
終了は　エスケープ　を　押して下さい。(*^^*)
m(__)m
（隠居Z） 2025/04/26(土) 13:16:45

 >A2〜A20セルを選択しその中でランダムに早、遅、夜、日を1個ずつ入力

 1) ランダムな4セルだけに入力
 Sub Randam4()
    Dim a, b, x, i&, temp
    a = [transpose(row(1:20))]
    b = [{"早","遅","夜","日"}]
    For i = 1 To UBound(b)
        x = WorksheetFunction.RandBetween(i, UBound(a))
        temp = a(i): a(i) = a(x): a(x) = temp
        x = WorksheetFunction.RandBetween(i, UBound(b))
        temp = b(i): b(i) = b(x): b(x) = temp
        Cells(a(i), 1) = b(i)
    Next
End Sub

 2)早、遅、夜、日をランダムに4セル毎に入力
 Sub RandomStep4()
    Dim a, i&, n&
    a = [{"早","遅","夜","日"}]
    For i = 1 To 5
        a = GetRand(a, 1, UBound(a))
        n = n + IIf(n, 4, 1)
        Cells(n, 1).Resize(4) = Application.Transpose(a)
    Next
End Sub

 Function GetRand(a, LB, UB)
    Dim i&, x, temp
    For i = LB To UB
        x = WorksheetFunction.RandBetween(i, UB)
        temp = a(i): a(i) = a(x): a(x) = temp
    Next
    GetRand = a
End Function
（jindon） 2025/04/26(土) 14:44:33

 >A2〜A20セルを選択しその中でランダムに早、遅、夜、日を1個ずつ入力

 私も「ランダムな4セルだけに入力」と解釈しました。

  Sub SetShift4()
    Const Shifts = "早 遅 夜 日"
    Dim targetR As Range: Set targetR = Range("A2:A20")
    targetR.ClearContents

    Dim col As New Collection, r As Range
    For Each r In targetR
        col.Add r
    Next

    Dim t, i As Long
    For Each t In Split(Shifts)
        i = WorksheetFunction.RandBetween(1, col.Count)
        col(i).Value = t
        col.Remove i
    Next
 End Sub
（hatena） 2025/04/26(土) 15:34:54

 > A2～A20セルを選択しその中でランダムに早、遅、夜、日を1個ずつ入力される
 ↓文字通りならこんな感じですかね？

 Sub test_main()
    Range("A2:A20").Select  'A2～A20セルを選択して
    Call test_sub           'その中へランダムに早、遅、夜、日を１個ずつ設定
 End Sub

 Sub test_sub()      '選択中のセル内へランダムに早、遅、夜、日を１個ずつ設定
    Dim i As Long, j As Long, MyArr As Variant
    MyArr = Array("早", "遅", "夜", "日")
    ReDim Preserve MyArr(Selection.Rows.Count - 1)
    For i = 0 To UBound(MyArr)
        j = WorksheetFunction.RandBetween(i, UBound(MyArr))
        Selection(1).Offset(i) = MyArr(j)
        MyArr(j) = MyArr(i)
    Next i
 End Sub
（通行人） 2025/04/26(土) 17:11:04

[[20250423153142]]『ランダムに入力』（タカ）
[[20250417063208]]『決まった文字を入力』（タカ）

（参考に） 2025/04/26(土) 17:39:10

皆様ご回答ありがとうございます

hatena様のコードを使用させて頂き上手く行きました

追加の質問で申し訳ないのですが
C2〜C20、D2〜D20､､､､､､と適応範囲を今後広げる可能性があるのですが
同じ内容のコードを適応範囲分作成すれば対応は可能ですか？
それとも回答頂いたコードに追加する事になりますか？

繰り返しの質問になってしまい申し訳ありません
宜しければご回答お願い致します
（タカ） 2025/04/26(土) 18:01:24

＞繰り返しの質問になってしまい申し訳ありません
＞宜しければご回答お願い致します
と言う前に
[[20250423153142]]『ランダムに入力』（タカ）
[[20250417063208]]『決まった文字を入力』（タカ）
後始末したらどうですか。
（とんびがぐるり） 2025/04/26(土) 20:50:19

 ＞ C2〜C20、D2〜D20､､､､､､と適応範囲を今後広げる可能性があるのですが

 適応範囲を引数にすればいいでしょう。

 Sub SetShift4(targetR As Range)
    Const Shifts = "早 遅 夜 日"
    targetR.ClearContents

    Dim col As New Collection, r As Range
    For Each r In targetR
        col.Add r
    Next

    Dim t, i As Long
    For Each t In Split(Shifts)
        i = WorksheetFunction.RandBetween(1, col.Count)
        col(i).Value = t
        col.Remove i
    Next
 End Sub

 C2〜C20、D2〜D20､､､､､､J2～J20 が適応範囲とすると、

 Sub test()
   Dim r As Range
   For Each r In Range("C2:J20").Columns
       SetShift4 r
   Next
 End Sub

（hatena） 2025/04/26(土) 22:39:19

C2〜C20、D2〜D20､､､､､､と適応範囲を今後広げる可能性があるのですが選択範囲としました。(ただし１列とする)
Sub Test()

    Dim a As Variant, i As Long
    Selection.ClearContents
    For Each a In Array("早", "遅", "夜", "日")
        Do
            i = Application.RandBetween(Selection(1).Row, Selection(Selection.Count).Row)
        Loop Until Cells(i, Selection.Column).Value = ""
        Cells(i, Selection.Column).Value = a
    Next
End Sub
（ぴんく） 2025/04/26(土) 22:40:45

 > C2～C20、D2～D20､､､､､､と適応範囲を今後広げる可能性が・・・
 ↓こんな感じとか？

 Sub test_main()
    Dim i As Long, MyArr As Variant
    MyArr = Array("A2:A20", "C2:C20", "D2:D20", "F2:F10", "F12:F20", "", "", "")
    For i = 0 To UBound(MyArr)
        If MyArr(i) <> "" Then
            test_sub Range(MyArr(i))    '処理範囲を１個ずつ指定して設定処理を起動
        End If
    Next i
 End Sub

 Sub test_sub(rng As Range)      '指定セル内へランダムに早,遅,夜,日を１個ずつ設定
    Dim i As Long, j As Long, MyArr As Variant
    MyArr = Array("早", "遅", "夜", "日")
    ReDim Preserve MyArr(rng.Rows.Count - 1)
    For i = 0 To UBound(MyArr)
        j = WorksheetFunction.RandBetween(i, UBound(MyArr))
        rng(i + 1) = MyArr(j)
        MyArr(j) = MyArr(i)
    Next i
 End Sub
（通行人） 2025/04/27(日) 07:33:06

 ひとつの列が日を表すなら、その決め方だと夜勤が2日（以上）続くことも発生しますよ、
[[20250417063208]]の話との関係はどうなっているんですか？

 # 回答があったら返事くらいはして欲しいですなあ。普通のマナーの問題です。

（xyz） 2025/04/27(日) 10:09:31

xyz様、他ご回答いただいた皆様
返信を怠ってしまい申し訳ありません
20250417063208の件ですが上司に確認した所
2日続いた際は調整してみるとの事でした
（タカ） 2025/04/28(月) 14:27:29

コメント返信：

[ 一覧(最新更新順) ]

[[20250426113105]] 『指定範囲内でランダムに入力』（タカ） ページの最後に飛ぶ

[[20250426113105]]　『指定範囲内でランダムに入力』（タカ）　ページの最後に飛ぶ