| |
▼よしこ さん：
こんにちわ。
前のマクロを改造しました。
でも３つの組み合わせの場合だと、あまり使えませんね。
詳細）
２つの組み合わせだと全パターン調べることができます。
３つの組み合わせは全パターン調べるわけではないので、
みつけられないこともあります。
マクロ中の*50の値を変更すれば確率が変わります。
*10にした場合、確率は低くなりますが、なかった場合のマクロ終了までの時間が短くなります。
*80にした場合、確率は高くなりますが、なかった場合のマクロ終了までの時間が長くなります。
以下、標準モジュールに記述して下さい。
Dim a As Integer, k As Integer
Private Sub ランダム合計2個()
Dim b As Integer, c As Integer, i As Integer, j As Integer
a = Range("A65536").End(xlUp).Row
c = Range("C1")
For j = 1 To a
b = c - Range("A" & j)
For i = j + 1 To a
If Range("A" & i) = b Then
k = 9
Exit For
End If
Next
If k = 9 Then Exit For
Next
If k <> 9 Then
MsgBox "２つの組み合わせはありません。続いて３つの組み合わせで探します。"
Else
Range("H1") = j & "行目の" & Range("A" & j)
Range("H2") = i & "行目の" & Range("A" & i)
End If
End Sub
Private Sub ランダム合計3個()
Dim b As Integer, c As Integer, d As Integer, e As Integer
Dim f As Integer, g As Integer, h As Integer
'合計値を格納
h = Range("C1")
'合計値になるまで繰り返す。"k"回繰り返し合計値にならなかったら抜ける
Do Until g = h Or k = a * 50
'Z4に数値が入力されるまで繰り返す
Do
'ランダムな整数値を格納
b = Int(a * Rnd) + 1
'C列の最終行を取得
c = Range("Z65536").End(xlUp).Row
'同じ数値がないか検索------------------------
With Range("Z2:Z4")
Set Rng = .Find(What:=b, MatchCase:=False)
End With
If Rng Is Nothing Then Range("Z" & c + 1) = b
'-------------------------------------------
Loop Until Range("Z4") <> ""
d = Range("Z2")
e = Range("Z3")
f = Range("Z4")
g = Range("A" & d) + Range("A" & e) + Range("A" & f)
Range("H1") = d & "行目の" & Range("A" & d)
Range("H2") = e & "行目の" & Range("A" & e)
Range("H3") = f & "行目の" & Range("A" & f)
Range("Z2").Clear
Range("Z3").Clear
Range("Z4").Clear
k = k + 1
Loop
End Sub
Sub 合計を合わせるマクロ()
Columns("H:H").Clear
Columns("Z:Z").Clear
Call ランダム合計2個
If k <> 9 Then Call ランダム合計3個
If k = a * 50 Then
MsgBox "合計値になる組み合わせはなさそうです。。"
Columns("H:H").Clear
End If
k = 0
End Sub
|
|
LC
- 03/6/18(水) 12:30 -
