如果使用 VBA Excel 相邻单元格不为空白，如何自动编号行？

Question

如果相邻单元格不为空，我需要使用 VBA 对行进行自动编号。
以下代码中的任何一个都可以完美运行，除非它与空白单元格相反。
一如既往，非常感谢您的支持。
这是预期的输出

Sub Fill_Serial_Numbers_Option1()
  Dim LastRow As Long
  LastRow = Cells(Rows.count, "B").End(xlUp).Row
  If LastRow > 2 Then
     Range("A3:A" & Application.Max(2, LastRow)) = Evaluate("ROW(A1:A" & LastRow & ")")
  End If
End Sub

Sub Fill_Serial_Numbers_Option2()
  Dim LastRow As Long
  LastRow = Cells(Rows.count, "B").End(xlUp).Row
  If LastRow > 2 Then
  With Range("A3:A" & LastRow)
    .Cells(1, 1).value = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
  End With
  End If
End Sub

Answer 1

请测试下一个代码：

Sub testCountNonBlanks()
   Dim sh As Worksheet, lastR As Long, arr, arrA, count As Long, i As Long
   Set sh = ActiveSheet
   lastR = sh.Range("B" & sh.rows.count).End(xlUp).row: count = 1
   If lastR <= 2 Then Exit Sub
   arr = sh.Range("B2:B" & lastR).value 'place the range in an array for faster iteration
   arrA = sh.Range("A2:A" & lastR).value
   For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then arrA(i, 1) = count: count = count + 1
   Next i
   sh.Range("A2").Resize(UBound(arrA), 1).value = arrA
End Sub

如果允许使用公式（用 VBA 编写），则可以使用下一个变体：

Sub testCountByFormula()
  Dim sh As Worksheet, lastR As Long, rngB As Range
  
   Set sh = ActiveSheet
   lastR = sh.Range("B" & sh.rows.count).End(xlUp).row
   Set rngB = sh.Range("B2:B" & lastR)
   sh.Range("A2:A10").Formula = "=IF(B2<>"""",COUNTA(" & rngB.Address & ")-COUNTA(" & rngB.Address(0, 1) & ")+1,"""")"
End Sub

Answer 2

您不需要宏来完成此操作。假设您关心的所有内容是否为空白，那么您可以在单元格A9 中使用这样的公式。 =Counta($B$1:$B9)如果你有公式，你可以尝试利用 COuntif 来利用一些东西。

Answer 3

您可以使用从第一行到最后一行的循环，如下所示：

Sub Fill()
    Dim LastRow As Long
    Dim Count As Integer
    Dim Row As Integer
    
    Count = 0
    Row = 1
    LastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
    
    Do While Row <= LastRow
        If Not (Cells(Row, 2) = "") Then
            Count = Count + 1
            Cells(Row, 1) = Count
        End If
        Row = Row + 1
        
    Loop

End Sub