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

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

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

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

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

textual
Листинг программы
Option Explicit
Option Base 1
Const MaxNum = 100
 
Private Sub CommandButton4_Click()
    Dim s$, ss$(), i&
    Debug.Print Controls("TextBox1").Text
    For i = 1 To 4
        s = s & vbLf & Controls("Label" & i).Caption & vbTab & _
        Controls("TextBox" & i).Text
    Next
    s = Replace(s, "введите", "", , , 1)
    ss = Split(Mid$(s, 2), vbLf)
    For i = 0 To UBound(ss)
        ss(i) = Trim$(ss(i))
        Mid(ss(i), 1, 1) = UCase(Mid(ss(i), 1, 1))
    Next
    s = Join(ss, vbLf)
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText s: .PutInClipboard
        On Error Resume Next
        [a6].Select
        ActiveSheet.Paste
    End With
End Sub
 
Private Sub CommandButton3_Click()
    Dim s$, ss$(), ll&(), i&, j&, v
    s = Replace(TextBox1.Text, " ", ""): ss = Split(s, ",")
    For i = 0 To UBound(ss)
        If IsNumeric(ss(i)) Then _
            j = j + 1: ReDim Preserve ll(j): ll(j) = ss(i)
    Next
    q ll, 1, j
    j = 0: s = ""
    For i = 1 To UBound(ll)
        j = j + ll(i)
        If j < Val(TextBox2.Text) Then
            s = s & " + " & ll(i): v = j
        Else: Exit For
        End If
    Next
    TextBox3.Text = UBound(Split(s, " + "))
    TextBox4.Text = Mid$(s, 4) & " = " & v
End Sub
 
Private Sub q(l&(), ll&, hh&)
    Dim i&, ii&, s&, w&
    i = ll: ii = hh: s = l((i + ii) \ 2)
    Do Until i > ii: Do While l(i) < s: i = i + 1: Loop: Do While l(ii) > s: ii = ii - 1: Loop
        If (i <= ii) Then w = l(i): l(i) = l(ii): l(ii) = w: i = i + 1: ii = ii - 1
    Loop
    If ll < ii Then q l, ll, ii
    If i < hh Then q l, i, hh
End Sub
 
Private Sub CommandButton1_Click()
    Dim r, ss$(), i&
    Do
        r = InputBox("Размер массива ?", , 10)
    Loop Until IsNumeric(r)
    ReDim ss(r)
    Randomize Timer
    For i = 1 To r
        ss(i) = Fix(Rnd * MaxNum)
    Next
    TextBox1.Text = Join(ss, ", ")
End Sub
 
Private Sub CommandButton2_Click()
    Randomize Timer
    TextBox2.Text = MaxNum
End Sub
 
 
Private Sub TextBox1_Change()
    Dim b As Boolean
    On Error Resume Next
    b = IsNumeric(Split(TextBox1.Text)(0))
    b = b And IsNumeric(TextBox2.Text)
    CommandButton3.Enabled = b
End Sub
 
Private Sub TextBox3_Change()
    Dim b As Boolean
    On Error Resume Next
    b = IsNumeric(Split(TextBox4.Text)(0))
    b = b And IsNumeric(TextBox3.Text)
    b = b And CommandButton3.Enabled
    CommandButton4.Enabled = b
End Sub
 
 
Private Sub UserForm_Activate()
    TextBox1_Change
    TextBox3_Change
    Me.Caption = "Выбрать максимальное количество чисел сумма которых не превышает P"
End Sub
 
Private Sub TextBox2_Change(): TextBox1_Change: End Sub
Private Sub TextBox4_Change(): TextBox3_Change: End Sub

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


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

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

10   голосов , оценка 4 из 5
Похожие ответы