VBAで、別列に記載の項目ごとの連番を振りたい

Question

#VBA（Excel）で、別列に記載の項目ごとに連番を振りたい

##目的：Excelの同一シート上で、A列で同一のものがある場合、B列に連番を付与させたい

###詳細
Excelのシート「dataA」に以下記載があります
(最上段は列名)

####元
AAA , BBB , CCC , DDD
OK1 , (null) , TEST11 , JP
OK1 , (null) , TEST22 , UN
OK1 , (null) , TEST33 , CN
OK2 , (null) , TEST44 , IK
OK2 , (null) , TEST55 , FR
OK3 , (null) , TEST66 , GM
OK3 , (null) , TEST77 , TR
OK3 , (null) , TEST88 , NC
OK4 , (null) , TEST99 , EG

ここで、
「AAA列が同じ値の際にBBB列に連番を付与したい」と思っています
AAA列はソート済みの状態です

####狙っている結果
AAA , BBB , CCC , DDD
OK1 , 1 , TEST11 , JP
OK1 , 2 , TEST22 , UN
OK1 , 3 , TEST33 , CN
OK2 , 1 , TEST44 , IK
OK2 , 2 , TEST55 , FR
OK3 , 1 , TEST66 , GM
OK3 , 2 , TEST77 , TR
OK3 , 3 , TEST88 , NC
OK4 , 1 , TEST99 , EG

###ここまで
連番を入れる方法は以下で可能と思われるのですが、
ここから先、どのように作成すればよいか、お分かりになられる方、
ご教授願えませんでしょうか

Dim i, STG, SYN
STG = 2
STN = 1

For i = STG To Cells(Rows.Count, 2).End(xlUp).Row
  Cells(i, 2).Value = STN
  STN = STN + 1
Next

Answer 1

B2セルに以下のセル関数を入力して必要な範囲にコピー

=COUNTIF(A$2:A2,A2)

VBAで同じことを実現するなら

Sub Macro1()
    With Range(Range("B2"), Cells(Cells(Rows.Count, 1).End(xlUp).Row, "B"))
        .FormulaR1C1 = "=COUNTIF(R2C[-1]:RC[-1],RC[-1])"
        .Value = .Value '数式を値に変換
    End With
End Sub

Comments

[amatsuno]

ありがとうございます。

Answer 2

あなたのコードをできるだけ生かすようにしました。

Option Explicit
Public Sub 連番を振る()
    Dim i, STG, STN, PREV
    STG = 2
    STN = 1
    PREV = ""
    For i = STG To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1).Value <> PREV Then
            STN = 1
        End If
        Cells(i, 2).Value = STN
        STN = STN + 1
        PREV = Cells(i, 1).Value
    Next
End Sub

Comments

[amatsuno]

ありがとうございます。
ご記載のコードで実現できました

Answer 3

こういうやり方ではどうでしょう

    Dim i As Long, STG As Long
    Dim key As String
    Dim dicT As Object
    
    STG = 2
    
    Set dicT = CreateObject("Scripting.Dictionary")

    For i = STG To Cells(Rows.count, "A").End(xlUp).row
        key = Cells(i, "A").Value

        If dicT.Exists(key) = False Then
            dicT.Add key, 1
        Else
            dicT(key) = dicT(key) + 1
        End If
        
        Cells(i, "B").Value = dicT(key)
    Next

Comments

[amatsuno]

ありがとうございます。
この部分で他にも入れる処理がありますので、参考とさせていただきます