如何确定给定单元格集中的哪些值将累加到数值范围

换句话说，我正在寻找一个由数组中的单元组合组成的和范围。给出一组数字：

1 720 56 17 59 120 153 203 39 1 690 583 582 561 256 310 232 95 108 16   26 59 538 445 42 149

（ call this A1:A26 ）

我正在寻找的总和范围是 1000-1500。我希望能够看到来自哪个细胞的组合 A1:A5 将在该范围内有一笔金额。如取（的总和） A23, A24, A26 ）或（的总和） A2, A11 ）。

只要总和落在给定范围内，细胞或组合的数量无关紧要。最重要的是，我需要能够识别每种组合中使用的细胞。

我很感激能让我的生活更轻松的人。
谢谢。

让我们走一个不同的方向，并展示两个单元格可以求和以满足critera，见下图。

仍然是一个问题的巨大挑战。如果可能的话，我会继续玩更完整的VBA答案。

我必须打破一段时间，但这是我所做的，向你展示符合标准的独特价值观。我绝不是VBA的专家，我只是把它作为一种学习经历。我确信我违反了一些规则。

Sub WhatCanSUM()

Dim lst As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim ilst1 As Integer
Dim ilst2 As Integer
Dim ilst3 As Integer
Dim ilst4 As Integer
Dim ilst5 As Integer
Dim ilst6 As Integer
Dim ilst7 As Integer
Dim ilst8 As Integer
Dim ilst9 As Integer
Dim ilst10 As Integer
Dim ilst11 As Integer
Dim ilst12 As Integer
Dim ilst13 As Integer
Dim ilst14 As Integer
Dim ilst15 As Integer
Dim ilst16 As Integer
Dim ilst17 As Integer
Dim ilst18 As Integer
Dim ilst19 As Integer
Dim ilst20 As Integer
Dim ilst21 As Integer
Dim ilst22 As Integer
Dim ilst23 As Integer
Dim ilst24 As Integer
Dim ilst25 As Integer
Dim ilst26 As Integer

Dim lwrlmt As Integer
Dim uprlmt As Integer
Dim result As Integer

Set lst = Sheet1.Range("lstNumbers")
i = 1
j = 1
k = 1
ilst1 = lst.Item(1).Value
ilst2 = lst.Item(2).Value
ilst3 = lst.Item(3).Value
ilst4 = lst.Item(4).Value
ilst5 = lst.Item(5).Value
ilst6 = lst.Item(6).Value
ilst7 = lst.Item(7).Value
ilst8 = lst.Item(8).Value
ilst9 = lst.Item(9).Value
ilst10 = lst.Item(10).Value
ilst11 = lst.Item(11).Value
ilst12 = lst.Item(12).Value
ilst13 = lst.Item(13).Value
ilst14 = lst.Item(14).Value
ilst15 = lst.Item(15).Value
ilst16 = lst.Item(16).Value
ilst17 = lst.Item(17).Value
ilst18 = lst.Item(18).Value
ilst19 = lst.Item(19).Value
ilst20 = lst.Item(20).Value
ilst21 = lst.Item(21).Value
ilst22 = lst.Item(22).Value
ilst23 = lst.Item(23).Value
ilst24 = lst.Item(24).Value
ilst25 = lst.Item(25).Value
ilst26 = lst.Item(26).Value
lwrmt = 1000
uprlmt = 1500
result = 0

'===============================================================================================
'Create worksheet if it doesnt exist.

Dim wrslt As Worksheet
Const strSheetName As String = "Results"

Set wrslt = Nothing
On Error Resume Next
Set wrslt = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0

If wrslt Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If
'===============================================================================================
'Little header messagge

Set wrslt = ActiveWorkbook.Worksheets(strSheetName)
wrslt.Cells.Delete
wrslt.Cells(1, 1).Value = "Resulting Additions that 2 distinct cells that sum up to >=" & lwrmt & " and <=" & uprlmt

'===============================================================================================
'The Loop

For j = 1 To lst.Rows.Count

    For i = 1 To lst.Rows.Count
    ilst2 = lst.Item(i + 1).Value
        result = (ilst1 + ilst2)
        If ilst1 <> ilst2 And result >= lwrmt And result <= uprlmt Then
            wrslt.Cells(i + 1, j).Value = ilst1 & " + " & ilst2
        End If
    Next i

    ilst1 = lst.Item(j + 1).Value

Next j

MsgBox ("Done")
'===============================================================================================
'Formatting

wrslt.Range("A1:M1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge

wrslt.Cells.EntireColumn.AutoFit
wrslt.Cells.SpecialCells(xlCellTypeConstants, 23).Select

End Sub

宏生成下面的图片。