URL /
Comment
'-----------------------------------------------------------
'■「いわゆる部分和問題」をExcelで解く-(旧７系：ソルバー)
'abyssinia.bbs.fc2.com/ act=reply&tid=2850777#5476703
'
' ◆動作仕様
'
' アクティブシートの
'
' ・A1セルに目標値
' ・B1セル以下に要素
'
' を入力して起動すると
'
' ・A2セルに発見した解の個数
' ・C列に解
'
' を書き出します｡…もし、あなたがあきらめる前に解が見つかればww
'
' ※ 事前に[SOLVER]を[参照設定]する必要があります。
' ※ その前に[Solver.xla]が開いている必要があります。
' ※ その前に[ソルバー]がインストールされている必要があります。
'
'-----------------------------------------------------------
URL /
Comment
'-----------------------------------------------------------
'■k0SSS_7_00
'ソルバー
'abyssinia.bbs.fc2.com/ act=reply&tid=2850777#5476703
'ジョークコードです。念のため。
'
'もっと速いオプション設定があるかもしれません。
'ソルバーマニアの人に訊いてみてください。
'わたし的にはどうでもいいです。
'
'事前に[SOLVER]を[参照設定]する必要があります。
'その前に[Solver.xla]が開いている必要があります。
'その前に[ソルバー]がインストールされている必要があります。
'-----------------------------------------------------------
'■親Ｐ-------------------------------------------
Sub k0SSS_7_00()
'●宣言-------------------------------
Dim itmCnt As Long '要素個数
Dim tgtSum As Long '目標和
Dim optCel As Range '目標値設定セル
Dim itmCel As Range '要素範囲上端セル
Dim tmpCel As Range '残和表示セル
Dim itmRng As Range '要素範囲
Dim tmpRng As Range '作業列
'●初期処理---------------------------
Set optCel = Range("A1")
Set itmCel = Range("B1")
Range(itmCel.Offset(, 1), Cells(Rows.Count, Columns.Count)).ClearContents
optCel.Offset(1).Clear
itmCnt = Cells(Rows.Count, itmCel.Column).End(xlUp).Row - itmCel.Row + 1
tgtSum = optCel.Value
Set tmpCel = optCel.Offset(1)
Set itmRng = itmCel.Resize(itmCnt)
Set tmpRng = itmCel.Offset(, 1).Resize(itmCnt)
tmpCel.Formula = "=SUMPRODUCT(" & itmRng.Address & "," & tmpRng.Address & ")"
Application.ScreenUpdating = False
'●主処理-----------------------------
SolverReset
SolverOk _
SetCell:=tmpCel.Address, _
MaxMinVal:=3, _
ValueOf:=optCel.Value, _
ByChange:=tmpRng.Address
SolverAdd _
CellRef:=tmpRng.Address, _
Relation:=5, _
FormulaText:="バイナリ"
SolverOptions _
MaxTime:=32767, _
Iterations:=32767, _
Precision:=0.000001, _
AssumeLinear:=False, _
StepThru:=False, _
Estimates:=1, _
Derivatives:=1, _
SearchOption:=1, _
IntTolerance:=5, _
Scaling:=False, _
Convergence:=0.0001, _
AssumeNonNeg:=False
SolverSolve _
userfinish:=True
'●表示-------------------------------
itmRng.Copy
tmpRng.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationMultiply
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------