『数値の合計が定数になる組み合わせを知りたい』（チュウ）

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 ＞
----
足すのは必ず2つですか？ それとも、幾つでも可能ですか？

いずれにせよ、ゴールシークが使える条件では無いようなので、式では無理でしょう。（3件中2件の合計だけならできますが、おそらく件数なんて不定ですよね？）
総当たりでループして、数字を合計して結果と比較するようなマクロを考えてみてはいかがでしょうか。
（???） 2018/09/05(水) 11:43
----
関数で出来るんですかね、、、
VBAなら

【データサンプル】
荻野	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
----
※３人で20になる場合４人で20になる場合などは考慮してません。
（TAKA） 2018/09/05(水) 11:54
----
私からも、必ず10行全て名前と値が埋まっていて、合計するのは必ず2件だけ、という条件の場合のマクロ例を書いておきます。
 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
----
Dim nStr As String
Dim m As Long
Dim n As Long
Dim rStr As String
Dim mRow As Long
Dim Nest As Long

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