Ваш прирост автоматически останавливается на r2.Rows.count
, поэтому вам нужно ограничить свой диапазон количеством имеющихся у вас данных (вместо жесткого кодирования 100
).
Если вы скажете VBA, что диапазон увеличендо 100
, тогда, конечно, цикл переходит к 100
.Просто используйте derlign
, чтобы ограничить ваш диапазон количеством данных, которые у вас есть в столбце B.
Set derlign = Range("B" & Rows.count).End(xlUp)
'MsgBox ("Dernière ligne " & derlign & " !")
Set r1 = Range("A2:A" & derlign.Row)
Set r2 = Range("B2:B" & derlign.Row)
For N = 2 To r2.Rows.count
If r2.Cells(N - 1, 1) = r2.Cells(N, 1) Then
r1.Cells(N, 1) = r1.Cells(N - 1, 1)
Else
r1.Cells(N, 1) = r1.Cells(N - 1, 1) + 1
End If
Next N
End Sub
На самом деле я бы изменил его на
Option Explicit
Sub WriteNumbering()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
LastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
Dim RefData As Variant 'read REF into array
RefData = ws.Range("B2:B" & LastRow).Value
Dim NumData As Variant 'read Num into array
NumData = ws.Range("A2:A" & LastRow).Value
NumData(1, 1) = 1 'start number
Dim iRow As Long
For iRow = LBound(RefData) + 1 To UBound(RefData) 'loop through array
If RefData(iRow, 1) = RefData(iRow - 1, 1) Then
NumData(iRow, 1) = NumData(iRow - 1, 1)
Else
NumData(iRow, 1) = NumData(iRow - 1, 1) + 1
End If
Next iRow
'write the array back to the cells
ws.Range("A2:A" & LastRow).Value = NumData
End Sub