Создайте ряд числовых строк на основе комбинаций True и False в другом столбце

Question

Вот таблица, с которой я работаю:

Я вручную ввожу "True" в столбце B для этого проекта. Например, я вручную ввожу столбец A, но цель состоит в том, чтобы получить те же результаты, просто ссылаясь на столбец B.

Мне нужно его подсчитать, начиная с 166, и добавлять к числовой строке до тех пор, пока соответствует true, двойному true (true спина к спине) или двойному пробелу (пустые ячейки спина к спине). Например, первая ячейка в столбце B пуста, вторая ячейка имеет значение «True», а третья ячейка пуста - поэтому она вводит 166, 167. Если бы она стала пустой> True> True, входное значение было бы 167, 168 , 169 в первых трех рядах.

В одной строке не может быть более двух истин, только одна или две. Если в строке два пробела, то будет введено только одно число (см. 179).

Мне нужно вводить одно и то же содержимое (например, 166, 167), пока не будет указано пробел> true> blank, blank > true> true или blank> blank условие выполнено. Затем он запускает новую строку и вводит данные на основе следующего условия и т. Д.

Извинения за то, что строка # является единичной, если это сбивает с толку ... номера строк не влияют на # ' s в столбце A, нужно просто сослаться на столбец B.

Спасибо за ваше время.

Answer 1

Я думаю, что получил его на работу. Пожалуйста, проверьте код ниже. Он должен быть установлен в кодовой таблице рабочего листа, на котором вы хотите получить результат.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Variatus @STO 07 Apr 2020

    Dim Arr As Variant
    Dim Rng As Range
    Dim Result As String
    Dim R As Long, Ra As Long

    With Target
        If .Cells.CountLarge > 1 Then Exit Sub

        Set Rng = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp).Offset(1))
        If Not Application.Intersect(Target, Rng) Is Nothing Then
            Arr = Range(Cells(1, 1), Cells(Rows.Count, 2).End(xlUp).Offset(1)).Value

            For R = 2 To Rng.Rows.Count
                If Result = "" Then Result = ResultString(Result, R, Arr)
                Arr(R, 1) = Result
                Cells(R, 1).Value = Result
                If R < UBound(Arr) Then
                    If Arr(R + 1, 2) = False Then
                        Result = ResultString(Result, R + 1, Arr)
                    End If
                End If
            Next R
        End If
    End With
End Sub

Private Function ResultString(ByVal Seed As Variant, _
                              ByVal R As Long, _
                              Arr As Variant) As String
    ' Variatus @STO 07 Apr 2020

    Const Start As Integer = 166

    Dim Fun As String
    Dim Sp() As String
    Dim i As Integer

    On Error Resume Next
    Sp = Split(Seed, ",")
    Seed = Val(Sp(UBound(Sp))) + 1
    If Err.Number Then Seed = Start
    Fun = Seed

    On Error GoTo 0
    Do While (R + i) < UBound(Arr)
        i = i + 1
        If Arr(R + i, 2) = False Then Exit Do
        Fun = Fun & ", " & CStr(Val(Seed) + i)
    Loop

    ResultString = Fun
End Function

Процедура обработки событий реагирует на изменения в столбце B и создает столбец A в соответствии с записями - True и False ( или пусто) - нашел там. Весь столбец должен быть перестроен при каждом изменении. Соблюдайте Const Start As Integer = 166, содержащий начальный номер.