填充系列 VBA 代码

填充系列 VBA 代码

我有一个代码,它会根据数据范围自动填充连续的数字。

这是我的代码:

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

但我不知道该怎么做?或者我应该在代码中添加什么。提前致谢!

答案1

您可以通过找出 B 列中哪一行有“人”来实现所需的输出,然后使用该行将增加的值插入到 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

相关内容