Блог

Мне нужно автоматически пронумеровать строки , если соседняя ячейка не пуста, используя 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" amp; Application.Max(2, LastRow)) = Evaluate("ROW(A1:A" amp; LastRow amp; ")")
  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" amp; LastRow)
    .Cells(1, 1).value = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
  End With
  End If
End Sub
 

Пожалуйста, протестируйте следующий код:

 Sub testCountNonBlanks()
   Dim sh As Worksheet, lastR As Long, arr, arrA, count As Long, i As Long
   Set sh = ActiveSheet
   lastR = sh.Range("B" amp; sh.rows.count).End(xlUp).row: count = 1
   If lastR <= 2 Then Exit Sub
   arr = sh.Range("B2:B" amp; lastR).value 'place the range in an array for faster iteration
   arrA = sh.Range("A2:A" amp; 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" amp; sh.rows.count).End(xlUp).row
   Set rngB = sh.Range("B2:B" amp; lastR)
   sh.Range("A2:A10").Formula = "=IF(B2<>"""",COUNTA(" amp; rngB.Address amp; ")-COUNTA(" amp; rngB.Address(0, 1) amp; ") 1,"""")"
End Sub
 

Для этого вам не нужен макрос. Предполагая, что все, что вас волнует, пустое или нет, вы можете использовать такую формулу в ячейке A9 . =Counta($B$1:$B9) Если у вас есть формулы, вы можете попытаться использовать что-то с помощью COuntif.

Вы можете использовать цикл от первого ряда до последнего, что-то вроде этого:

 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