Excel VBA实现指定选数求和并筛选符合范围结果的技术咨询

核心实现思路 #

1. 读取手动输入的30个数字存入数组
2. 遍历数组中每个元素，将其作为步骤2的目标数（直接乘以1.5）
3. 对每个目标数，从剩余29个元素里生成所有5个元素的不重复组合
4. 计算每个组合的总求和值：目标数*1.5 + 5个元素的和
5. 筛选出总和在指定范围内的结果并输出

完整VBA代码 #

Sub CalculateValidSums()
    Dim inputRange As Range
    Dim numArr As Variant
    Dim targetVal As Double
    Dim remainingArr As Variant
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
    Dim totalSum As Double
    Dim minLimit As Double, maxLimit As Double
    
    ' 选择存储30个数字的单元格区域
    Set inputRange = Application.InputBox("请选择包含30个数字的单元格区域", Type:=8)
    numArr = inputRange.Value
    numArr = Application.Transpose(numArr) ' 转为一维数组
    
    ' 自定义求和范围（可根据需求修改）
    minLimit = 100
    maxLimit = 200
    
    ' 初始化输出区域（用Sheet2的A列开始，可自行调整）
    Sheet2.Cells.Clear
    Sheet2.Range("A1:D1") = Array("目标数(乘1.5后)", "选中的5个数字", "总和", "是否符合范围")
    
    Dim outputRow As Long
    outputRow = 2
    
    ' 遍历每个元素作为步骤2的目标数
    For i = 1 To UBound(numArr)
        targetVal = numArr(i) * 1.5
        
        ' 生成排除当前目标数的剩余数组
        ReDim remainingArr(1 To UBound(numArr) - 1)
        Dim idx As Long
        idx = 1
        For j = 1 To UBound(numArr)
            If j <> i Then
                remainingArr(idx) = numArr(j)
                idx = idx + 1
            End If
        Next j
        
        ' 生成剩余数组中5个元素的所有不重复组合
        For j = 1 To UBound(remainingArr) - 4
            For k = j + 1 To UBound(remainingArr) - 3
                For l = k + 1 To UBound(remainingArr) - 2
                    For m = l + 1 To UBound(remainingArr) - 1
                        For n = m + 1 To UBound(remainingArr)
                            ' 计算总和
                            totalSum = targetVal + remainingArr(j) + remainingArr(k) + remainingArr(l) + remainingArr(m) + remainingArr(n)
                            
                            ' 判断是否在指定范围内
                            Dim inRange As String
                            inRange = "否"
                            If totalSum >= minLimit And totalSum <= maxLimit Then
                                inRange = "是"
                                ' 写入结果到工作表
                                Sheet2.Cells(outputRow, 1) = targetVal
                                Sheet2.Cells(outputRow, 2) = remainingArr(j) & ", " & remainingArr(k) & ", " & remainingArr(l) & ", " & remainingArr(m) & ", " & remainingArr(n)
                                Sheet2.Cells(outputRow, 3) = totalSum
                                Sheet2.Cells(outputRow, 4) = inRange
                                outputRow = outputRow + 1
                            End If
                        Next n
                    Next m
                Next l
            Next k
        Next j
    Next i
    
    MsgBox "计算完成，结果已输出到Sheet2"
End Sub

关键逻辑说明 #

• 步骤2的融入方式：通过外层循环逐个取出数组元素并乘以1.5作为目标值，同时生成排除当前元素的剩余数组，确保后续选5个元素时不会重复选中目标数。
• 组合去重：用五层嵌套循环遍历剩余数组，通过j < k < l < m < n的索引顺序，避免生成重复的元素组合。
• 范围筛选：每次计算总和后直接判断是否在设定的上下限之间，符合条件的结果实时写入工作表，便于后续查看。

内容的提问来源于stack exchange，提问作者Zenia