Сколько надо купить заготовок длиной 150 см? - VB

Private Sub Command1_Click()
     Dim arr(), res, ArrB() As typeBrd, k As Long, dL As Long, t0 As Long, tL As Long, st As String
     Dim n As Long, i As Long, j As Long, LB As Long, sum As Long, s As String
     Call GetData(ArrB(), n)
     LB = Val(Text3.Text): List1.Clear: Label2.Visible = True: txtRes.Text = "": txtRes1.Text = "": Command1.Enabled = False: DoEvents
     ReDim arr(1 To 1)
     For i = 1 To n
         For j = 1 To ArrB(i).CntB
            k = k + 1
            ReDim Preserve arr(1 To k): arr(k) = ArrB(i).LenB
         Next j
     Next i
m:   Do
       sum = 0: s = ""
       Call compRes(arr, k)
       res = LongSumEl(arr(), LB, dL)
       If VarType(res) = 8195 Then
          For i = LBound(res) To UBound(res)
               If res(i) <> 0 Then
                   s = s & res(i) & "   ": sum = sum + res(i)
                   For j = 1 To k
                        If res(i) = arr(j) Then res(i) = 0: arr(j) = 0  '
                   Next j
               End If
          Next i
          Label2.Caption = Val(k / 100): DoEvents
          If sum = 0 Then GoTo m1
          st = st & tL + 1 & "." & vbTab & s & "   Отходы  " & LB - sum & vbCrLf
          t0 = t0 + (LB - sum): tL = tL + 1
       Else
          If sumRes(arr, k) < LB And res <> LB Then
            For j = 1 To k
                  If arr(j) <> 0 Then s = s & arr(j) & "   ": arr(j) = 0
            Next j
            st = st & tL + 1 & "." & vbTab & s & "   Отходы  " & res & vbCrLf
            t0 = t0 + Val(res): tL = tL + 1
            GoTo m1
          End If
          Exit Do
       End If
    Loop
    
    If dL <= maxL(ArrB(), n) Then dL = dL + 5: GoTo m
m1:
    'Вывод результата
     On Error Resume Next
    List1.AddItem " "
    List1.AddItem "Всего потребуется заготовок " & tL
    List1.AddItem "Отходы (всего ) " & t0
    List1.AddItem "Отходы (заготовки, шт) " & Round(t0 / LB, 2)
    List1.AddItem "Отходы (всего, %) " & Round(((t0 / LB) / tL) * 100, 2)
    txtRes.Text = st
    Label2.Visible = False: Command1.Enabled = True: DoEvents
    txtRes1.Text = compStr(st)
    
End Sub
Private Function compStr(s As String) As String
    Dim st, i As Long, j As Long, n As Long, tmp1 As String, tmp2 As String, k As Long
    st = Split(s, vbCrLf): n = UBound(st)
    tmp1 = Split(st(0), vbTab)(1)
    k = 1
    For i = 1 To n
        If st(i) <> "" Then
         tmp2 = Split(st(i), vbTab)(1)
         If tmp1 = tmp2 Then
             k = k + 1
         Else
             compStr = compStr & k & " раз " & vbTab & tmp1 & vbCrLf
             k = 1
             If st(i) <> "" Then tmp1 = Split(st(i), vbTab)(1)
         End If
        End If
    Next i
    compStr = compStr & k & " раз " & vbTab & tmp1 & vbCrLf
End Function
Private Sub compRes(res, n As Long)
    Dim a() As Variant, i As Long, k As Long
    ReDim a(1 To 1)
    For i = 1 To n
        If res(i) <> 0 Then k = k + 1: ReDim Preserve a(1 To k): a(k) = res(i)
    Next i
    res = a: n = k
End Sub
Private Function sumRes(a(), n As Long) As Long
    Dim i As Long
    For i = 1 To n
        sumRes = sumRes + a(i)
    Next i
End Function
Private Function maxL(ArrB() As typeBrd, n) As Long
    Dim i As Long: maxL = ArrB(1).LenB
    For i = 1 To n
        If ArrB(i).LenB > maxL And ArrB(i).CntB > 0 Then maxL = ArrB(i).LenB
    Next i
End Function
Private Sub GetData(ArrB() As typeBrd, n As Long)
     n = 5
     ReDim ArrB(1 To n)
     Dim i As Long
     For i = 1 To n
         ArrB(i).LenB = Val(Text1(i - 1).Text)
         ArrB(i).CntB = Val(Text2(i - 1).Text)
     Next i
End Sub
 
Function LongSumEl(arr(), sm As Long, Optional ds As Long = 0)
 
    Dim out&(), i&, j&, k&, n&, L&, sm1&
    
    n = sm ' + ds
    sm1 = sm - ds
    
    If n > 80000000 Or n < 0 Then Exit Function
    ReDim a&(n)
    For i = 1 To n: a(i) = -1: Next i
    For i = 1 To UBound(arr)
        For j = n - arr(i) To 0 Step -1
            If a(j) >= 0 Then
                k = j + arr(i)
                If a(k) = -1 Then a(k) = j
                If k >= sm1 Then
                    Do
                        L = L + 1
                        ReDim Preserve out&(1 To L)
                        out(L) = k - a(k)
                        k = a(k)
                    Loop While k
                    LongSumEl = out
                    Exit Function
                End If
            End If
    Next j, i
    For i = sm To 1 Step -1
        If a(i) >= 0 Then Exit For
    Next i
    LongSumEl = sm - i
End Function