[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『数値の合計が定数になる組み合わせを知りたい』（チュウ）
A1〜A10に人名、B1〜B10に数量（数値）が入力されています。
B1〜B10の範囲で、合計が20になる組み合わせを知りたいです。
例えば、
A1＝木村、B1＝9
A2＝藤井、B2＝13
A3＝佐藤、B3＝11
となっている時に、
「足した合計が20になる組み合わせは、A1木村の9とA2佐藤の11です」
といったような結果が表示される数式があれば、教えてください。
よろしくお願いします。
＜ 使用 Excel：Excel2013、使用 OS：WindowsVista ＞
いずれにせよ、ゴールシークが使える条件では無いようなので、式では無理でしょう。（3件中2件の合計だけならできますが、おそらく件数なんて不定ですよね？）
総当たりでループして、数字を合計して結果と比較するようなマクロを考えてみてはいかがでしょうか。
（???） 2018/09/05(水) 11:43
【データサンプル】
荻野 9
寺尾 13
西谷 11
谷本 2
笠井 8
牧田 7
岡野 5
足立 18
田辺 15
Sub Test()
Dim i As Long, ii As Long, x As Long, y As String, myArr(10)
With ThisWorkbook.Sheets("Sheet1")
For i = 1 To 10
x = .Cells(i, "B").Value
For ii = 1 To 10
If .Cells(ii, "B").Value + .Cells(i, "B").Value = 20 Then
myArr(i) = .Cells(i, "A") & "と" & .Cells(ii, "A") & " , "
End If
Next ii
Next i
End With
y = "足した合計が20になる組み合わせは" & vbCrLf
For i = 1 To 5
If myArr(i) <> "" Then
y = y & myArr(i)
End If
Next i
MsgBox y
End Sub
【結果】
足した合計が20になる組み合わせは
荻野と西谷 , 寺尾と牧田 , 西谷と荻野 , 谷本と足立 ,
（TAKA） 2018/09/05(水) 11:51
Sub test()
Const TGT = 20
Dim i As Long
Dim j As Long
Dim iR As Long
For i = 1 To 10
For j = i + 1 To 10
If Cells(i, "B").Value + Cells(j, "B").Value = TGT Then
Cells(iR + 1, "D").Value = "足した合計が" & TGT & "になる組み合わせは、" & Cells(i, "A").Address(0, 0) & Cells(i, "A").Value & "の" & Cells(i, "B").Value & "と" & Cells(j, "A").Address(0, 0) & Cells(j, "A").Value & "の" & Cells(j, "B").Value & "です"
iR = iR + 1
End If
Next j
Next i
End Sub
（???） 2018/09/05(水) 11:58
Sub Test()
Dim i As Long, ii As Long, x As Long, y As String, myArr(10)
With ThisWorkbook.Sheets("Sheet1")
For i = 1 To 10
x = .Cells(i, "B").Value
For ii = 1 To 10
If .Cells(ii, "B").Value + .Cells(i, "B").Value = 20 Then
myArr(i) = .Cells(i, "A") & "と" & .Cells(ii, "A") & " , "
End If
Next ii
Next i
End With
y = "足した合計が20になる組み合わせは" & vbCrLf
For i = 1 To 10
If myArr(i) <> "" Then
y = y & myArr(i)
End If
Next i
Range("A11") = y
MsgBox y
End Sub
で結果は
足した合計が20になる組み合わせは
荻野と西谷 , 寺尾と牧田 , 西谷と荻野 , 谷本と足立 , 牧田と寺尾 , 岡野と田辺 , 足立と谷本 , 田辺と岡野 ,
です。
でもこれだと同じ組み合わせが出てきますよね、、
なんとかなりそうですけど頭パンクしそうなのでここまでにしておきます。
参考程度にしてください
（TAKA） 2018/09/05(水) 11:58
3人で20、4人で20、それ以上もすべて含みます。
それだとパターンが多すぎて難しそうですね。
それでも参考になりました。
ありがとうございます。
（チュウ） 2018/09/05(水) 12:58
Sub main()
'データシートがアクティブな状態で実施
'データシートの一行目からＡ，Ｂ列にデータが入っていること
'例：Ａ１＝萩野、Ｂ１＝9 など
Dim i As Long, tot As Long, c As Range, r As Range
tot = 30 '合計値(変更可)
i = 1
Set asht = ActiveSheet
nStr = ""
Application.ScreenUpdating = False
asht.Columns("A:A").Insert Shift:=xlToRight
For Each c In Columns("B").SpecialCells(2)
c.Offset(, -1).Value = Chr(i)
nStr = nStr & Chr(i)
i = i + 1
Next c
If Not Evaluate("isref('wk'!a1)") Then
Sheets.Add
ActiveSheet.Name = "wk"
End If
If Not Evaluate("isref('wk2'!a1)") Then
Sheets.Add
ActiveSheet.Name = "wk2"
End If
m = 1
n = Len(nStr)
Do While m <= n
rStr = String(m, " ")
Sheets("wk").Cells.ClearContents
Sheets("wk2").Cells.ClearContents
mRow = 0
Nest = 0
combiPr (0)
For Each c In Sheets("wk").Cells.SpecialCells(2)
Sheets("wk2").Cells(c.Row, c.Column).Value = WorksheetFunction.VLookup(c.Value, asht.Range("A:C"), 2)
Sheets("wk2").Cells(c.Row, c.Column).Value = Sheets("wk2").Cells(c.Row, c.Column).Value
c.Formula = WorksheetFunction.VLookup(c.Value, asht.Range("A:C"), 3)
c.Value = c.Value
Next c
For Each c In Sheets("wk").Range("A:A").SpecialCells(2)
If Application.WorksheetFunction.Sum(c.EntireRow) = tot Then
comm = ""
For Each r In c.EntireRow.SpecialCells(2)
comm = comm & Sheets("wk2").Cells(r.Row, r.Column).Value & r.Value & vbLf
Next r
MsgBox comm
End If
Next c
m = m + 1
Loop
asht.Columns("A:A").Delete Shift:=xlToLeft
Application.DisplayAlerts = False
Sheets("wk").Delete
Application.DisplayAlerts = False
Sheets("wk2").Delete
End Sub
Sub combiPr(n1)
Dim mCol As Integer
For nn = n1 + 1 To n - m + Nest + 1
Nest = Nest + 1
Mid(rStr, Nest, 1) = Mid(nStr, nn, 1)
If Nest = m Then
mRow = mRow + 1
For mCol = 1 To m
Sheets("wk").Cells(mRow, mCol).Value = Mid(rStr, mCol, 1)
Next
Else
Call combiPr(nn)
End If
Nest = Nest - 1
Next
End Sub
（mm） 2018/09/05(水) 18:04
ちょっと興味が沸いたので。
10個の数値で、2〜10個を使って出来る全ての組合せは、1013通りです。 さすがにちょっと作るのは少々時間がかかりますが、それら全ての組合せを作業列で求めれば数式でも可能です。 手順は以下です。
A〜B列に名前と数値 D〜E列に結果を表示 G〜S列Sに作業列
D1 =IFERROR(INDEX(G:G,MATCH(ROW(A1),$I:$I,0)),"") E列と1013行目までフィルコピー
G1 =INDEX(A:A,$J1)&","&INDEX(A:A,$K1)&IF($L1="","",","&INDEX(A:A,$L1))&IF($M1="","",","&INDEX(A:A,$M1))&IF($N1="","",","&INDEX(A:A,$N1))&IF($O1="","",","&INDEX(A:A,$O1))&IF($P1="","",","&INDEX(A:A,$P1))&IF($Q1="","",","&INDEX(A:A,$Q1))&IF($R1="","",","&INDEX(A:A,$R1))&IF($S1="","",","&INDEX(A:A,$S1)) H列と1013行目までフィルコピー
I1 =IF(INDEX(B:B,J1)+INDEX(B:B,K1)+IF(L1="",0,INDEX(B:B,L1))+IF(M1="",0,INDEX(B:B,M1))+IF(N1="",0,INDEX(B:B,N1))+IF(O1="",0,INDEX(B:B,O1))+IF(P1="",0,INDEX(B:B,P1))+IF(Q1="",0,INDEX(B:B,Q1))+IF(R1="",0,INDEX(B:B,R1))+IF(S1="",0,INDEX(B:B,S1))=20,1,"") 1013行目までフィルコピー
ここからはちょっと複雑です。 J2以降の数式で特に表記の無いものは1012行目までフィルコピーして下さい。
J1 1を入力 K1 2を入力
J2 =IF(J1=10-COUNT(K1:S1),1,IF(K1=12-COUNT(J1:S1),J1+1,J1))
K2 =J2+COUNTIF(J$1:J2,J2) K45までフィルコピー
K46 =IF(K45=10-COUNT(L45:$S45),J46+1,IF(L45=11-COUNT(L45:$S45),K45+1,K45))
L46 =K46+COUNTIFS(J$46:J46,J46,K$46:K46,K46) L165までフィルコピー
L166 =IF(L165=10-COUNT(M165:$S165),K166+1,IF(M165=11-COUNT(M165:$S165),L165+1,L165))
M166 =L166+COUNTIFS(J$166:J166,J166,K$166:K166,K166,L$166:L166,L166) M375までフィルコピー
M376 =IF(M375=10-COUNT(N375:$S375),L376+1,IF(N375=11-COUNT(N375:$S375),M375+1,M375))
N376 =M376+COUNTIFS(J$376:J376,J376,K$376:K376,K376,L$376:L376,L376,M$376:M376,M376) N627までフィルコピー
N628 =IF(N627=10-COUNT(O627:$S627),M628+1,IF(O627=11-COUNT(O627:$S627),N627+1,N627))
O628 =N628+COUNTIFS(J$628:J628,J628,K$628:K628,K628,L$628:L628,L628,M$628:M628,M628,N$628:N628,N628) O837までフィルコピー
O838 =IF(O837=10-COUNT(P837:$S837),N838+1,IF(P837=11-COUNT(P837:$S837),O837+1,O837))
P838 =O838+COUNTIFS(J$838:J838,J838,K$838:K838,K838,L$838:L838,L838,M$838:M838,M838,N$838:N838,N838,O$838:O838,O838) P957までフィルコピー
P958 =IF(P957=10-COUNT(Q957:$S957),O958+1,IF(Q957=11-COUNT(Q957:$S957),P957+1,P957))
Q958 =P958+COUNTIFS(J$958:J958,J958,K$958:K958,K958,L$958:L958,L958,M$958:M958,M958,N$958:N958,N958,O$958:O958,O958,P$958:P958,P958) Q1002までフィルコピー
Q1003 =IF(Q1002=10-COUNT(R1002:$S1002),P1003+1,IF(R1002=11-COUNT(R1002:$S1002),Q1002+1,Q1002)) R1003 =Q1003+COUNTIFS(J$1003:J1003,J1003,K$1003:K1003,K1003,L$1003:L1003,L1003,M$1003:M1003,M1003,N$1003:N1003,N1003,O$1003:O1003,O1003,P$1003:P1003,P1003,Q$1003:Q1003,Q1003)
J1013〜S1013まで、1〜10を入力
以下のマクロを初めの1回だけ実行すれば、数式が自動で入力されます。
Sub 作成()
Range("D1:E1013").Formula = "=IFERROR(INDEX(G:G,MATCH(ROW(A1),$I:$I,0)),"""")"
Range("G1:H1013").Formula = "=INDEX(A:A,$J1)&"",""&INDEX(A:A,$K1)&IF($L1="""","""","",""&" _
& "INDEX(A:A,$L1))&IF($M1="""","""","",""&INDEX(A:A,$M1))&IF($N1="""","""","",""&" _
& "INDEX(A:A,$N1))&IF($O1="""","""","",""&INDEX(A:A,$O1))&IF($P1="""","""","",""&" _
& "INDEX(A:A,$P1))&IF($Q1="""","""","",""&INDEX(A:A,$Q1))&IF($R1="""","""","",""&" _
& "INDEX(A:A,$R1))&IF($S1="""","""","",""&INDEX(A:A,$S1))"
Range("I1").Formula = "=IF(INDEX(B:B,J1)+INDEX(B:B,K1)+IF(L1="""",0,INDEX(B:B,L1))" _
& "+IF(M1="""",0,INDEX(B:B,M1))+IF(N1="""",0,INDEX(B:B,N1))+IF(O1="""",0,INDEX(B:B,O1))" _
& "+IF(P1="""",0,INDEX(B:B,P1))+IF(Q1="""",0,INDEX(B:B,Q1))+IF(R1="""",0,INDEX(B:B,R1))" _
& "+IF(S1="""",0,INDEX(B:B,S1))=20,1,"""")"
Range("I2:I1013").Formula = "=IF(INDEX(B:B,J2)+INDEX(B:B,K2)+IF(L2="""",0,INDEX(B:B,L2))" _
& "+IF(M2="""",0,INDEX(B:B,M2))+IF(N2="""",0,INDEX(B:B,N2))+IF(O2="""",0,INDEX(B:B,O2))" _
& "+IF(P2="""",0,INDEX(B:B,P2))+IF(Q2="""",0,INDEX(B:B,Q2))+IF(R2="""",0,INDEX(B:B,R2))" _
& "+IF(S2="""",0,INDEX(B:B,S2))=20,MAX(I$1:I1)+1,"""")"
Range("J1").Value = 1
Range("K1").Value = 2
Range("J2:J1012").Formula = "=IF(J1=10-COUNT(K1:S1),1,IF(K1=12-COUNT(J1:S1),J1+1,J1))"
Range("K2:K45").Formula = "=J2+COUNTIF(J$1:J2,J2)"
Range("K46:K1012").Formula = "=IF(K45=10-COUNT(L45:$S45),J46+1,IF(L45=11-COUNT(L45:$S45),K45+1,K45))"
Range("L46:L165").Formula = "=K46+COUNTIFS(J$46:J46,J46,K$46:K46,K46)"
Range("L166:L1012").Formula = "=IF(L165=10-COUNT(M165:$S165),K166+1,IF(M165=11-COUNT(M165:$S165),L165+1,L165))"
Range("M166:M375").Formula = "=L166+COUNTIFS(J$166:J166,J166,K$166:K166,K166,L$166:L166,L166)"
Range("M376:M1012").Formula = "=IF(M375=10-COUNT(N375:$S375),L376+1,IF(N375=11-COUNT(N375:$S375),M375+1,M375))"
Range("N376:N627").Formula = "=M376+COUNTIFS(J$376:J376,J376,K$376:K376,K376,L$376:L376,L376,M$376:M376,M376)"
Range("N628:N1012").Formula = "=IF(N627=10-COUNT(O627:$S627),M628+1,IF(O627=11-COUNT(O627:$S627),N627+1,N627))"
Range("O628:O837").Formula = "=N628+COUNTIFS(J$628:J628,J628,K$628:K628,K628,L$628:L628,L628,M$628:M628,M628,N$628:N628,N628)"
Range("O838:O1012").Formula = "=IF(O837=10-COUNT(P837:$S837),N838+1,IF(P837=11-COUNT(P837:$S837),O837+1,O837))"
Range("P838:P957").Formula = "=O838+COUNTIFS(J$838:J838,J838,K$838:K838,K838,L$838:L838,L838,M$838:M838,M838,N$838:N838,N838,O$838:O838,O838)"
Range("P958:P1012").Formula = "=IF(P957=10-COUNT(Q957:$S957),O958+1,IF(Q957=11-COUNT(Q957:$S957),P957+1,P957))"
Range("Q958:Q1002").Formula = "=P958+COUNTIFS(J$958:J958,J958,K$958:K958,K958,L$958:L958,L958,M$958:M958,M958,N$958:N958,N958,O$958:O958,O958,P$958:P958,P958)"
Range("Q1003:Q1012").Formula = "=IF(Q1002=10-COUNT(R1002:$S1002),P1003+1,IF(R1002=11-COUNT(R1002:$S1002),Q1002+1,Q1002))"
Range("R1003:R1012").Formula = "=Q1003+COUNTIFS(J$1003:J1003,J1003,K$1003:K1003,K1003,L$1003:L1003,L1003,M$1003:M1003,M1003,N$1003:N1003,N1003,O$1003:O1003,O1003,P$1003:P1003,P1003,Q$1003:Q1003,Q1003)"
Range("J1013:S1013").Value = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
End Sub
（sy） 2018/09/10(月) 03:43
マクロで求めるなら簡単ですね。 元データが20個くらいまでなら数秒で総当たり出来ます。 数式と同じように、D〜E列に結果を出力します。
Sub test()
Dim i As Long, k As Long, m As Long, p As Long
Dim v1, v2(), v3()
Dim CValue As Long
Const TValue As Long = 20 '目標値を指定
v1 = Range("A1").CurrentRegion.Value
i = WorksheetFunction.Combin(UBound(v1, 1), Int(UBound(v1, 1) / 2))
If i > 1048576 Then i = 1048576
ReDim v3(1 To i, 1 To 2)
p = 1
For i = 2 To UBound(v1, 1)
ReDim v2(1 To i)
For k = 1 To i
v2(k) = k
Next k
Do
CValue = 0
For k = 1 To i
CValue = CValue + v1(v2(k), 2)
Next k
If CValue = TValue Then
For k = 1 To i
v3(p, 1) = v3(p, 1) & "," & v1(v2(k), 1)
v3(p, 2) = v3(p, 2) & "," & v1(v2(k), 2)
Next k
v3(p, 1) = Mid(v3(p, 1), 2)
v3(p, 2) = Mid(v3(p, 2), 2)
p = p + 1
End If
If v2(1) = UBound(v1, 1) - UBound(v2) + 1 Then Exit Do
If v2(UBound(v2)) = UBound(v1, 1) Then
For k = UBound(v2) - 1 To 1 Step -1
If v2(k) < UBound(v1, 1) - (UBound(v2) - k) Then
v2(k) = v2(k) + 1
For m = k + 1 To UBound(v2)
v2(m) = v2(m - 1) + 1
Next m
Exit For
End If
Next k
Else
v2(UBound(v2)) = v2(UBound(v2)) + 1
End If
Loop
Next i
Range("D1:E" & UBound(v3, 1)).Value = v3
End Sub
（sy） 2018/09/10(月) 03:46
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.