ランダムに数字を入れ込み、合計を特定の値にする処理について

投稿者 : 社畜     投稿日時 : 2022/03/11(Fri) 00:19:38     OS : Windows 10     EXCEL : Excel 2013

---

Excel VBAについての質問です。
以下のような処理を行いたいです。


セルA1～セルA5に値が入っています。
再計算（F9）を行うことで、セルA1～セルA5の項目が空白になったります。
セルA1～セルA5に値が入っているものを"、"区切りで出力しています。
この時、セルの値が取れたものだけを”、”区切りで出力しています。

（例）
あ、い、お
い、う、え、お
え、お


その後、ランダムに値の後ろに数字0.5～3.5を入れて
ランダムの後ろの合計が6.5になるようにしたいです。

（例）
あ3、い2、お1.5
い2.5、う2.5、え1、お0.5
え3、お3.5


仕事で引き継いで案件を請け負っていますが、頼る人がいないため、ご回答のほど宜しくお願い申し上げます。
勉強不足で申し訳ございません。

投稿者 : てらてら     投稿日時 : 2022/03/11(Fri) 10:45:09

---

こんにちわ。

出力先が判らないので、メッセージボックスにしておきました。

Sub 合計が一致する乱数5項目()

    Dim s As Integer
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim d As Integer
    Dim e As Integer
    Dim i As Integer
    Dim str As String
    
    '全て空白の時は無限ループになるので中止
    If Range("A1") = "" And Range("A2") = "" And Range("A3") = "" _
        And Range("A4") = "" And Range("A5") = "" Then
        Exit Sub
    End If
    
    Do Until s = 65
    
        a = 0
        b = 0
        c = 0
        d = 0
        e = 0
        
        Randomize
        
        If Range("A1") <> "" Then a = Int(35 * Rnd + 5)
        If Range("A2") <> "" Then b = Int(35 * Rnd + 5)
        If Range("A3") <> "" Then c = Int(35 * Rnd + 5)
        If Range("A4") <> "" Then d = Int(35 * Rnd + 5)
        If Range("A5") <> "" Then e = Int(35 * Rnd + 5)
        
        s = a + b + c + d + e
        
    Loop
    
    Range("B1") = a / 10
    Range("B2") = b / 10
    Range("B3") = c / 10
    Range("B4") = d / 10
    Range("B5") = e / 10
    
    str = ""
    For i = 1 To 5
        If Cells(i, "A") <> "" Then
            str = str & Cells(i, "A") & Cells(i, "B") & "、"
        End If
    Next i
    
    str = Left(str, Len(str) - 1)
    
    MsgBox str
    
End Sub

投稿者 : 社畜     投稿日時 : 2022/03/11(Fri) 12:12:47

---

てらてら様

はじめまして。
ご回答いただき、ありがとうございます。

端末を触れる環境にいないため、今晩試してみたいと思います。

投稿者 : 社畜     投稿日時 : 2022/03/12(Sat) 01:07:09

---

■[返信 1] てらてらさん（2022-03-11 10:45:09）の記事
＞ こんにちわ。
＞
＞ 出力先が判らないので、メッセージボックスにしておきました。
＞
＞
＞ Sub 合計が一致する乱数5項目()
＞
＞ Dim s As Integer
＞ Dim a As Integer
＞ Dim b As Integer
＞ Dim c As Integer
＞ Dim d As Integer
＞ Dim e As Integer
＞ Dim i As Integer
＞ Dim str As String
＞
＞ '全て空白の時は無限ループになるので中止
＞ If Range("A1") = "" And Range("A2") = "" And Range("A3") = "" _
＞ And Range("A4") = "" And Range("A5") = "" Then
＞ Exit Sub
＞ End If
＞
＞ Do Until s = 65
＞
＞ a = 0
＞ b = 0
＞ c = 0
＞ d = 0
＞ e = 0
＞
＞ Randomize
＞
＞ If Range("A1") <> "" Then a = Int(35 * Rnd + 5)
＞ If Range("A2") <> "" Then b = Int(35 * Rnd + 5)
＞ If Range("A3") <> "" Then c = Int(35 * Rnd + 5)
＞ If Range("A4") <> "" Then d = Int(35 * Rnd + 5)
＞ If Range("A5") <> "" Then e = Int(35 * Rnd + 5)
＞
＞ s = a + b + c + d + e
＞
＞ Loop
＞
＞ Range("B1") = a / 10
＞ Range("B2") = b / 10
＞ Range("B3") = c / 10
＞ Range("B4") = d / 10
＞ Range("B5") = e / 10
＞
＞ str = ""
＞ For i = 1 To 5
＞ If Cells(i, "A") <> "" Then
＞ str = str & Cells(i, "A") & Cells(i, "B") & "、"
＞ End If
＞ Next i
＞
＞ str = Left(str, Len(str) - 1)
＞
＞ MsgBox str
＞
＞ End Sub


てらてら様
こんばんは。ご回答ありがとうございます。
早速、確認してみました。

1点わたくしの伝え方が悪い点がございまして、
誤）その後、ランダムに値の後ろに数字0.5～3.5を入れて
正）その後、ランダムに値の後ろに0.5区切りで数字（0.5、1、1.5、2、2.5、3、3.5）を入れて
と訂正させていただきたく存じます。
この場合、Rndを用いての算出は可能となるのでしょうか。


また、追加の質問で大変恐縮ではございますが、
ランダムに値の後ろに数字（0.5、1、1.5、2、2.5、3、3.5）の最大値を0.5区切りで任意に設定し、
3.5と設定した場合は（0.5、1、1.5、2、2.5、3、3.5）の組み合わせで合計が6.5となり、
2.5と設定した場合は（0.5、1、1.5、2、2.5）の組み合わせで合計が6.5となるような対応は可能なのでしょうか。
さらに、合計の6.5も0.5区切りで任意に変更可能なのでしょうか。

頼りきりになってしまい申し訳ございません。

投稿者 : てらてら     投稿日時 : 2022/03/12(Sat) 07:36:30

---

ちょろい。

Sub 合計が一致する乱数5項目_設定可()

    Dim s As Integer
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim d As Integer
    Dim e As Integer
    Dim i As Integer
    Dim str As String
    
    Dim 合計値 As Long
    Dim 刻み As Long
    
    合計値 = 65     '合計値は10倍でセット
    
    刻み = 7
    '刻みは要素数
    '3.5と設定したい場合は（0.5、1、1.5、2、2.5、3、3.5）で 7
    '2.5と設定したい場合は（0.5、1、1.5、2、2.5）で　5
    
    '全て空白の時は無限ループになるので中止
    If Range("A1") = "" And Range("A2") = "" And Range("A3") = "" _
        And Range("A4") = "" And Range("A5") = "" Then
        Exit Sub
    End If
    i = 1
    Do Until s = 合計値
    
        a = 0
        b = 0
        c = 0
        d = 0
        e = 0
        
        Randomize
        
        If Range("A1") <> "" Then a = Int(刻み * Rnd + 1)
        If Range("A2") <> "" Then b = Int(刻み * Rnd + 1)
        If Range("A3") <> "" Then c = Int(刻み * Rnd + 1)
        If Range("A4") <> "" Then d = Int(刻み * Rnd + 1)
        If Range("A5") <> "" Then e = Int(刻み * Rnd + 1)
        
        s = (a + b + c + d + e) * 5
        
        i = i + 1
        If i > 1000 Then
            MsgBox "所定回数を超えました。"
            Exit Sub
        End If
    Loop
    
    Range("B1") = a * 0.5
    Range("B2") = b * 0.5
    Range("B3") = c * 0.5
    Range("B4") = d * 0.5
    Range("B5") = e * 0.5
    
    str = ""
    For i = 1 To 5
        If Cells(i, "A") <> "" Then
            str = str & Cells(i, "A") & Cells(i, "B") & "、"
        End If
    Next i
    
    str = Left(str, Len(str) - 1)
    
    MsgBox str
    
End Sub

投稿者 : 社畜     投稿日時 : 2022/03/16(Wed) 12:43:57

---

■[返信 4] てらてらさん（2022-03-12 07:36:30）の記事
＞ ちょろい。
＞
＞ Sub 合計が一致する乱数5項目_設定可()
＞
＞ Dim s As Integer
＞ Dim a As Integer
＞ Dim b As Integer
＞ Dim c As Integer
＞ Dim d As Integer
＞ Dim e As Integer
＞ Dim i As Integer
＞ Dim str As String
＞
＞ Dim 合計値 As Long
＞ Dim 刻み As Long
＞
＞ 合計値 = 65 '合計値は10倍でセット
＞
＞ 刻み = 7
＞ '刻みは要素数
＞ '3.5と設定したい場合は（0.5、1、1.5、2、2.5、3、3.5）で 7
＞ '2.5と設定したい場合は（0.5、1、1.5、2、2.5）で　5
＞
＞ '全て空白の時は無限ループになるので中止
＞ If Range("A1") = "" And Range("A2") = "" And Range("A3") = "" _
＞ And Range("A4") = "" And Range("A5") = "" Then
＞ Exit Sub
＞ End If
＞ i = 1
＞ Do Until s = 合計値
＞
＞ a = 0
＞ b = 0
＞ c = 0
＞ d = 0
＞ e = 0
＞
＞ Randomize
＞
＞ If Range("A1") <> "" Then a = Int(刻み * Rnd + 1)
＞ If Range("A2") <> "" Then b = Int(刻み * Rnd + 1)
＞ If Range("A3") <> "" Then c = Int(刻み * Rnd + 1)
＞ If Range("A4") <> "" Then d = Int(刻み * Rnd + 1)
＞ If Range("A5") <> "" Then e = Int(刻み * Rnd + 1)
＞
＞ s = (a + b + c + d + e) * 5
＞
＞ i = i + 1
＞ If i > 1000 Then
＞ MsgBox "所定回数を超えました。"
＞ Exit Sub
＞ End If
＞ Loop
＞
＞ Range("B1") = a * 0.5
＞ Range("B2") = b * 0.5
＞ Range("B3") = c * 0.5
＞ Range("B4") = d * 0.5
＞ Range("B5") = e * 0.5
＞
＞ str = ""
＞ For i = 1 To 5
＞ If Cells(i, "A") <> "" Then
＞ str = str & Cells(i, "A") & Cells(i, "B") & "、"
＞ End If
＞ Next i
＞
＞ str = Left(str, Len(str) - 1)
＞
＞ MsgBox str
＞
＞ End Sub


てらてら様

お世話になっております。
返事が遅くなってしまい、大変申し訳ございません。

早急なご対応ありがとうございました。
想定通りの動きとなることを確認致しました。

ご回答いただきありがとうございました。