Остановить приращение значения в ячейке в соответствии с другим значением в другой ячейке - PullRequest
0 голосов
/ 24 мая 2019

Согласно моему прецедентному сообщению

Мне нужно остановить приращение, но я не узнаю ...

Мой код:

Range("A2").Value = "1"
Set derlign = Range("B" & Rows.count).End(xlUp)
'MsgBox ("Dernière ligne " & derlign & " !")
Set r1 = Range("A2:A100")
Set r2 = Range("B2:B100")
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`

но это дает мне:

N°  REF
1   305-77-871
2   402-88-920
2   402-88-920
3   406-55-585
3   406-55-585
3   406-55-585
4   404-11-885
4   404-11-885
4
4
4
...

Не могли бы вы помочь мне остановить приращение?

Ответы [ 2 ]

1 голос
/ 24 мая 2019

Ваш прирост автоматически останавливается на 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
0 голосов
/ 24 мая 2019

Для раннего выхода из цикла вы можете использовать инструкцию «Exit For»

If [condition] Then Exit For
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...