👀 Підбір доданків для потрібної суми за допомогою VBA

Attribute VB_Name = "Module1"

Sub Combinator2()

  Dim Data() As Variant, goal As Double, sel_count As Integer, prec As Double, t As Single, AddSum As Double

  Const LIMIT = 1000000

  Randomize

'значення ПОХІБКИ

  prec = Range("H5").Value

'К-ть накладних

  sel_count = Range("H2").Value

' БАЖАНА СУМА

  goal = Range("H4").Value

'Список накладних

  Set OutRange = Range("H8")

  Set InputRange = Range("B2", Range("B2").End(xlDown))

  input_count = InputRange.Cells.Count

  Data = InputRange.Value

  t = Timer

  Do

    AddSum = 0

    For j = 1 To sel_count

      RandomIndex = Int(Rnd * (input_count - j + 1) + j)

      RandomValue = Data(RandomIndex, 1)

      AddSum = AddSum + RandomValue

      Data(RandomIndex, 1) = Data(j, 1)

      Data(j, 1) = RandomValue

    Next j

    If Abs(AddSum - goal) <= prec Then

      Range("H3").Value = AddSum

      Debug.Print Timer - t, iterations

      MsgBox "Підбір завершено!"

      Range(OutRange, OutRange.End(xlDown)).ClearContents

      OutRange.Resize(sel_count, 1).Value = Data

      Exit Sub

    End If

    iterations = iterations + 1

  Loop While iterations <= LIMIT

  Debug.Print Timer - t

  MsgBox "Рішення не знайдено"

End Sub