[[20060809134930]]　『複数の数字の中から探し出す？』（REE）　ページの最後に飛ぶ

『複数の数字の中から探し出す？』（REE）

たとえば・・・1.2.3.4.5.6.7.8.9.10.....と一杯数字がありますよね？では足した合計が10になるにはどの数字を組み合わせればいいのかしら？1と2と7で10みたいな計算方法ありませんか？

 全文検索してみました＾＾
　
https://www.excel.studio-kazu.jp/cgi-bin/estindex/estseek2.cgi?phrase=%E6%95%B0%E5%AD%97%E3%80%80%E7%B5%84%E3%81%BF%E5%90%88%E3%82%8F%E3%81%9B&perpage=10&attr=&order=&clip=-1
　
 参考になりますでしょうか？
 （キリキ）(〃⌒o⌒)b

 例えばA1から下へ
 1
 2
 3　　　　
 4
 5　　　　　　　
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 かういう塩梅に数値が並んどるとします。
 抽出したいセルに
        =picnum(範囲,合計の数値,何個）と書き込みます
        =picnum(A1:A20,20)  　　←２個で合計２０になる数値の検索引数を省略ok
        =picnum(A1:A20,20,3)　　←３個で合計２０になる数値を検索
        =picnum(A1:A20,20,4)　　←４個で　
        =picnum(A1:A20,20,5)　　←５個で
 Alt+F11でVBEを開き
 挿入　標準モジュール　へ下のコードをコピペ
 但し抽出データがセルの文字制限に引っかかるとエラーがまっせぇ。
 　　　　　　（弥太郎）
 '---------------------------------
 Option Explicit
 Function PicNum(adrs As Range, fnd_data As Long, Optional fnd_count As Long = 2)
    Dim i As Long, x As Long, y As Long, t As Long, f As Long, j As Integer
    Dim tbl, m_row, fnd_tbl, data()
    tbl = adrs.Value
    On Error Resume Next

    Select Case fnd_count
        Case 2
            For i = 1 To UBound(tbl, 1)
                If tbl(i, 1) < fnd_data Then
                    fnd_tbl = adrs.Cells(1, 1).Offset(i).Resize(UBound(tbl, 1) - i).Value
                    x = fnd_data - tbl(i, 1)
                    m_row = Application.Match(x, fnd_tbl, 0)
                    If Not IsError(m_row) Then
                        ReDim Preserve data(j)
                        data(j) = tbl(i, 1) & "," & x
                        j = j + 1
                    End If
                End If
            Next i
        Case 3
            For i = 1 To UBound(tbl, 1)
                If tbl(i, 1) < fnd_data Then
                    For y = i + 1 To UBound(tbl, 1) - i
                        If tbl(i, 1) + tbl(y, 1) < fnd_data Then
                            fnd_tbl = adrs.Cells(1, 1).Offset(y).Resize(UBound(tbl, 1) - y).Value
                            x = fnd_data - (tbl(i, 1) + tbl(y, 1))
                            m_row = Application.Match(x, fnd_tbl, 0)
                            If Not IsError(m_row) Then
                                ReDim Preserve data(j)
                                data(j) = tbl(i, 1) & "," & tbl(y, 1) & "," & x
                                j = j + 1
                            End If
                        End If
                    Next y
                End If
            Next i
        Case 4
            For i = 1 To UBound(tbl, 1)
                If tbl(i, 1) < fnd_data Then
                    For y = i + 1 To UBound(tbl, 1) - i
                        If tbl(i, 1) + tbl(y, 1) < fnd_data Then
                            For t = y + 1 To UBound(tbl, 1) - y
                                If tbl(i, 1) + tbl(y, 1) + tbl(t, 1) < fnd_data Then
                                    fnd_tbl = adrs.Cells(1, 1).Offset(t).Resize(UBound(tbl, 1) - t).Value
                                    x = fnd_data - (tbl(i, 1) + tbl(y, 1) + tbl(t, 1))
                                    m_row = Application.Match(x, fnd_tbl, 0)
                                    If Not IsError(m_row) Then
                                        ReDim Preserve data(j)
                                        data(j) = tbl(i, 1) & "," & tbl(y, 1) & "," & tbl(t, 1) & "," & x
                                        j = j + 1
                                    End If
                                End If
                            Next t
                        End If
                    Next y
                End If
            Next i
       Case 5
            For i = 1 To UBound(tbl, 1)
                If tbl(i, 1) < fnd_data Then
                    For y = i + 1 To UBound(tbl, 1) - i
                        If tbl(i, 1) + tbl(y, 1) < fnd_data Then
                            For t = y + 1 To UBound(tbl, 1) - y
                                If tbl(i, 1) + tbl(y, 1) + tbl(t, 1) < fnd_data Then
                                    For f = t + 1 To UBound(tbl, 1) - f
                                        If tbl(i, 1) + tbl(y, 1) + tbl(t, 1) + tbl(f, 1) < fnd_data Then
                                            fnd_tbl = adrs.Cells(1, 1).Offset(f).Resize(UBound(tbl, 1) _
                                                                    - f).Value
                                            x = fnd_data - (tbl(i, 1) + tbl(y, 1) + tbl(t, 1) + tbl(f, 1))
                                            m_row = Application.Match(x, fnd_tbl, 0)
                                            If Not IsError(m_row) Then
                                                ReDim Preserve data(j)
                                                data(j) = tbl(i, 1) & "," & tbl(y, 1) & "," & tbl(t, 1) _
                                                                & "," & tbl(f, 1) & "," & x
                                                j = j + 1
                                            End If
                                        End If
                                    Next f
                                End If
                            Next t
                        End If
                    Next y
                End If
            Next i
        End Select
        PicNum = Join(data, "/")
        On Error GoTo 0
 End Function

 ちょっとていせぇ16:01（弥太郎）
 もひとつてぇせぇ16:22（弥太郎）

弥太郎さま
早速のお助けありがとうございます。
ですが、【Alt+F11でVBEを開き挿入　標準モジュール　へ下のコードをコピペ】の
挿入をしても・・・標準モジュールが出てこないのです。
何が原因でしょうか？（REE)

 こんな塩梅でっせ！
１）Alt + F11 で、Microsoht Visual Basic を立ち上げる
２）挿入 → 標準モジュール
３）出てきた白い画面に、コードをコピペ
　
 以上ですわ
　
 （キリキ）（〃⌒o⌒)b

ありがとう。キリキさん
ですが・・・挿入→標準モジュール・・・の標準モジュールが色が薄くなってってひらかないのですわ（REE)

 せんせぇ、フォローおおきに～・ｗ３阿
 これってどういう事でッか？
 新しいブックで試してもあきまへんか？
 こんなトラブル聞いた事無いですなぁ・・・。
 　　　（弥太郎）

コメント返信：

[ 一覧(最新更新順) ]

[[20060809134930]] 『複数の数字の中から探し出す？』（REE） ページの最後に飛ぶ

[[20060809134930]]　『複数の数字の中から探し出す？』（REE）　ページの最後に飛ぶ