Выбрать максимальное количество чисел, сумма которых не превышает P - VBA

Узнай цену своей работы

Формулировка задачи:

Дан набор натуральных чисел и число P. Выбрать максимальное количество чисел, сумма которых не превышает P Р - это не пи, а просто любое число Размерности массивов вводить с клавиатуры. Элементы массивов по желанию пользователя вводить с клавиатуры или генерировать случайным образом в заданных пределах. Исходные данные и результаты выводить на экран дисплея в табличном виде. Должна быть форма, с кнопочками и прочим. Ломаем голову уже 3тий день с одногрупником, никто не может помочь...

Решение задачи: «Выбрать максимальное количество чисел, сумма которых не превышает P»

textual
Листинг программы
  1. Option Explicit
  2. Option Base 1
  3. Const MaxNum = 100
  4.  
  5. Private Sub CommandButton4_Click()
  6.     Dim s$, ss$(), i&
  7.     Debug.Print Controls("TextBox1").Text
  8.     For i = 1 To 4
  9.         s = s & vbLf & Controls("Label" & i).Caption & vbTab & _
  10.         Controls("TextBox" & i).Text
  11.     Next
  12.     s = Replace(s, "введите", "", , , 1)
  13.     ss = Split(Mid$(s, 2), vbLf)
  14.     For i = 0 To UBound(ss)
  15.         ss(i) = Trim$(ss(i))
  16.         Mid(ss(i), 1, 1) = UCase(Mid(ss(i), 1, 1))
  17.     Next
  18.     s = Join(ss, vbLf)
  19.     With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  20.         .SetText s: .PutInClipboard
  21.         On Error Resume Next
  22.         [a6].Select
  23.         ActiveSheet.Paste
  24.     End With
  25. End Sub
  26.  
  27. Private Sub CommandButton3_Click()
  28.     Dim s$, ss$(), ll&(), i&, j&, v
  29.     s = Replace(TextBox1.Text, " ", ""): ss = Split(s, ",")
  30.     For i = 0 To UBound(ss)
  31.         If IsNumeric(ss(i)) Then _
  32.             j = j + 1: ReDim Preserve ll(j): ll(j) = ss(i)
  33.     Next
  34.     q ll, 1, j
  35.     j = 0: s = ""
  36.     For i = 1 To UBound(ll)
  37.         j = j + ll(i)
  38.         If j < Val(TextBox2.Text) Then
  39.             s = s & " + " & ll(i): v = j
  40.         Else: Exit For
  41.         End If
  42.     Next
  43.     TextBox3.Text = UBound(Split(s, " + "))
  44.     TextBox4.Text = Mid$(s, 4) & " = " & v
  45. End Sub
  46.  
  47. Private Sub q(l&(), ll&, hh&)
  48.     Dim i&, ii&, s&, w&
  49.     i = ll: ii = hh: s = l((i + ii) \ 2)
  50.     Do Until i > ii: Do While l(i) < s: i = i + 1: Loop: Do While l(ii) > s: ii = ii - 1: Loop
  51.         If (i <= ii) Then w = l(i): l(i) = l(ii): l(ii) = w: i = i + 1: ii = ii - 1
  52.     Loop
  53.     If ll < ii Then q l, ll, ii
  54.     If i < hh Then q l, i, hh
  55. End Sub
  56.  
  57. Private Sub CommandButton1_Click()
  58.     Dim r, ss$(), i&
  59.     Do
  60.         r = InputBox("Размер массива ?", , 10)
  61.     Loop Until IsNumeric(r)
  62.     ReDim ss(r)
  63.     Randomize Timer
  64.     For i = 1 To r
  65.         ss(i) = Fix(Rnd * MaxNum)
  66.     Next
  67.     TextBox1.Text = Join(ss, ", ")
  68. End Sub
  69.  
  70. Private Sub CommandButton2_Click()
  71.     Randomize Timer
  72.     TextBox2.Text = MaxNum
  73. End Sub
  74.  
  75.  
  76. Private Sub TextBox1_Change()
  77.     Dim b As Boolean
  78.     On Error Resume Next
  79.     b = IsNumeric(Split(TextBox1.Text)(0))
  80.     b = b And IsNumeric(TextBox2.Text)
  81.     CommandButton3.Enabled = b
  82. End Sub
  83.  
  84. Private Sub TextBox3_Change()
  85.     Dim b As Boolean
  86.     On Error Resume Next
  87.     b = IsNumeric(Split(TextBox4.Text)(0))
  88.     b = b And IsNumeric(TextBox3.Text)
  89.     b = b And CommandButton3.Enabled
  90.     CommandButton4.Enabled = b
  91. End Sub
  92.  
  93.  
  94. Private Sub UserForm_Activate()
  95.     TextBox1_Change
  96.     TextBox3_Change
  97.     Me.Caption = "Выбрать максимальное количество чисел сумма которых не превышает P"
  98. End Sub
  99.  
  100. Private Sub TextBox2_Change(): TextBox1_Change: End Sub
  101. Private Sub TextBox4_Change(): TextBox3_Change: End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

10   голосов , оценка 4 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы