Excel VBA, Сортировка по конкретному лимиту

Question

Я написал код Excel VBA, но по какой-то причине он не работает полностью нормально. У меня есть определенная длина 21 (ячейка E2) и список сотовых номеров ниже (столбец E на картинке) Код работает в каждой ячейке в столбце E и добавляет его к определенной сумме. если сумма до этой ячейки ниже или равна 21 (ячейка E2), то ячейка справа получает число «1». Если он выше, чем 21, мы перезапускаем сумму и делаем это снова, пока не достигнем предела (21), и все ячейки справа получат число «2» и так далее до конца списка. Как вы можете видеть на картинке его работу для последней ячейки (окрашены в желтый цвет), за исключением, где он должен быть 4, а не 3 (потому что 5 + 5 + 5 + 4 + 3 = 22> 21)

Я не могу найти, где у меня проблема. Это мой код:

Length = Range("E2").Value 
    Range("E3").Select 
    i = 1 
    sumOfLen = 0 

    Do Until Selection.Offset(1, 0).Value = Empty 
     Do Until sumOfLen > Length Or Selection.Value = Empty 
      Selection.Offset(0, 1).Value = i 
      sumOfLen = sumOfLen + Selection.Value 
      Selection.Offset(1, 0).Select 
     Loop 
     Selection.Offset(-1, 0).Select 
     sumOfLen = 0 
     i = i + 1 
    Loop 

Любая помощь будет принята с благодарностью.

Answer 1

Это потому, что вы возвращаете сумму в 0, а не текущее значение диапазона (например, 5).

Могу я предложить следующий код?

Option Explicit 

Public Sub doIt() 
    Dim i As Long 
    Dim curSum As Long 
    Dim maxSum As Long 
    Dim curRange As Range 

    maxSum = Range("E2").Value 
    Set curRange = Range("E3") 
    i = 1 

    Do While (curRange.Value <> "") 
     curSum = curSum + curRange.Value 
     If (curSum > maxSum) Then 
      i = i + 1 
      curSum = curRange.Value 
     End If 

     curRange.Offset(0, 1).Value = i 
     Set curRange = curRange.Offset(1, 0) 
    Loop 
End Sub 

Если вы хотите сохранить ваш код, вам нужно изменить:

sumOfLen = 0

в этот

sumOfLen = Selection.Value