使用Excel VBA遍历行以设置递增计数器

Question

“必填”字段是需要填充的字段，

• 对于每个UNIQUE Serial“ REQUIRED”，仅在加星号“ *”时加1。 在VBA中。

这就是它的外观。

http://s2.postimg.org/nketog5t5/table.jpg

Serial Number   REQUIRED    Starred SEQ_NO
040846/Z/96/C   1   *   1
040846/Z/96/C   2   *   2
040846/Z/96/C           3
042190/Z/96/F   1   *   1
042368/Z/97/B   1   *   1
042368/Z/97/B           2
042368/Z/97/B   2   *   3
042368/Z/97/B           4
042368/Z/97/B   3   *   5
042368/Z/97/B           6
042368/Z/97/B           7
042368/Z/97/B           8
047608/Z/96/B   1   *   1
047608/Z/96/B           2
047675/Z/96/D   1   *   1
047675/Z/96/D   2   *   2
047675/Z/96/D           3

Answer 1

将此公式粘贴到您要填充的列下。 如果您担心的话，可以稍作调整以隐藏零。

=COUNTIFS($A$2:A2,A2,$C$2:C2,"*")

注意该公式中的硬引用与相对引用，并确保您的输入与这些对齐。

Answer 2

请尝试这个

Sub increment()
Dim prevalue As String
Dim curvalue As String
Dim lstrow As Long, i As Long, j As Integer

lstrow = Range("A" & Sheets("Sheet1").Rows.Count).End(xlUp).Row
j = 0

For i = 2 To lstrow
    curvalue = Range("A" & i).Value
    If curvalue = prevalue And Range("A" & i).Offset(0, 2).Value = "*" Then
        j = j + 1
        Range("A" & i).Offset(0, 1).Value = j
    ElseIf curvalue <> prevalue And Range("A" & i).Offset(0, 2).Value = "*" Then
        j = 1
        Range("A" & i).Offset(0, 1).Value = j
    End If
    prevalue = curvalue
Next i
End Sub