使用 VBA 优化大型数据集（求解器不工作）

Question

我有大量数据，我需要在这些数据上获得一组达到所需数字的值。 更准确地说，我有超市门票，每张都有一个 ID 号和向客户收取的金额。

我必须拿起添加到特定数字（比如说 1,000,000 美元）的票。 我尝试使用求解器，在其中一列中使用二进制 1/0 变量，然后只需 sumif 即可获得求解器选择的加起来目标值 1M 的变量。 但是，这在样本很小的情况下有效。 我刚得到的文件有超过 280,000 张票，所以求解器无法处理这么多的二进制变量。

如何在一列中获得加起来为 1,000,000 的票数？ 我尝试使用“while”循环，但我的计算机在 5 分钟左右后崩溃。 有任何想法吗？

谢谢！

Answer 1

这是你想要的吗？ 在 A1:A11 中输入逻辑。

=RANDBETWEEN(1,50)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A1)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A2)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A3)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A4)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A5)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A6)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A7)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A8)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A9)),0)
=SUM(A1:A10)

结果

或者，也许这个。 在 A1:A41 中输入

8 6 3 2 6 10 9 4 12 8 6 1 8 10 8 14 10 9 12 12 14 6 4 3 4 4 4 0 6 10 4 9 6 3 11 12 10 7 12 8 8

将 92 放入单元格 B1，然后运行此 VBA。

Sub FindSeries()

Dim StartRng As Range
Dim EndRng As Range
Dim Answer As Long
Dim TestTotal As Long

Answer = Range("B1") '<<< CHANGE

Set StartRng = Range("A1")
Set EndRng = StartRng
Do Until False
    TestTotal = Application.Sum(Range(StartRng, EndRng))
    If TestTotal = Answer Then
        Range(StartRng, EndRng).Select
        Exit Do
    ElseIf TestTotal > Answer Then
        Set StartRng = StartRng(2, 1)
        Set EndRng = StartRng
    Else
        Set EndRng = EndRng(2, 1)
        If EndRng.Value = vbNullString Then
            MsgBox "No series found"
            Exit Do
        End If
    End If
Loop
End Sub