Заполните код VBA серии

Question

У меня есть код, который будет автоматически заполнять порядковые номера в зависимости от диапазона данных.

вот мой код:

Dim Lst As Long
Lst = Range("B" & Rows.Count).End(xlUp).Row
With Range("A12")
    .Value = "1"
    .AutoFill Destination:=Range("A12").Resize(Lst - 11), Type:=xlFillSeries
End With

хорошо это работало хорошо, но у меня есть этот вывод. В прошлый раз я уже спрашивал, как очистить дубликаты.

вот вывод, когда я применяю последовательные числа:

No |   Col 2   | Col 1
  1|  Person 1 | 1. Question 1
  2|           | 2. Question 2
  3|           | 3. Question 3
    -------------------------
  4|  Person 2 | 1. Question 1
  5|           | 2. Question 2
  6|           | 3. Question 3
    -------------------------
  7| Person 3  | 1. Question 1
  8|           | 2. Question 2
  9|           | 3. Question 3

Я хочу, чтобы это было так:

No |   Col 2   | Col 1
  1|  Person 1 | 1. Question 1
   |           | 2. Question 2
   |           | 3. Question 3
    -------------------------
  2|  Person 2 | 1. Question 1
   |           | 2. Question 2
   |           | 3. Question 3
    -------------------------
  3| Person 3  | 1. Question 1
   |           | 2. Question 2
   |           | 3. Question 3

но я не знаю как? или что я добавлю в код. заранее спасибо!!

Answer 1

Вы можете получить желаемый результат, выяснив, какая строка в столбце B имеет значение Person, а затем использовать эту строку, чтобы вставить увеличенное значение в соответствующую строку столбца A.

Чтобы узнать больше, ознакомьтесь с приведенным ниже кодом, читая комментарии, чтобы дать вам советы о том, что делает код.

Sub OrderColumn()
    Dim cellsInRange As Range
    Dim selectedRange As Range

    Set selectedRange = Range("B12:B" & LastRow(2)) 'Use LastRow(column) function to find the last row with a value in "column".
    i = 0 'This is our value that increments.

    For Each cellsInRange In selectedRange.Cells
        If Range("B" & (cellsInRange.Row)).Value = "" Then
            'Do nothing.
        Else
            i = i + 1 'Increment i by 1.
            Range("A" & (cellsInRange.Row)).Value = i 'Add i as the new cell value.
        End If
    Next cellsInRange

End Sub
Function LastRow(column As Long)
    LastRow = Cells(Rows.Count, column).End(xlUp).Row
End Function