上のセルと値が同じなら数を連番にしたい

Question

いつもこちらにお世話になっております。
画像のようにA列を対象に、Aの値が下の値と同じ場合に
B列の数字を連続で入れるコードを書きたいです。

A列には200行、値が入る予定です。

 '//使用セルの最終行を取得
     Dim fin_line As Long, k
            With ws1.UsedRange
                fin_line = .Rows(.Rows.Count).Row
            End With
    For k = 2 To fin_line
Dim range1 As Object
    i = 1
        For Each range1 In ws.Cells(k, 1)
        ws.Activate
        ws.Range("A1").Activate
           
            ActiveCell.Offset(1, 0).Activate
            If ActiveCell.Value = ws.Cells(k, 1) Then
                ws1.Cells(k, 2).Value = k - 1
            Else
                ws1.Cells(k, 2).Value = i
            End If
            Next range1
　　　　　　Next k

For Each range1 In ws.Cells(k, 1)
上記でアプリケーション定義、オブジェクト定義のエラーが出てしまいます。
知恵を貸していただけると幸いです

Answer 1

まずwsとws1が別物なのかタイプミスなのかをはっきりさせましょう。
（Option Explicitを指定した方がいいと思います。）

なお、やりたいことはもう少しシンプルに書けそうな気がします。

Sub sample()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim fin_line As Long, k
    With ws.UsedRange
        fin_line = .Rows(.Rows.Count).Row
    End With
    
    ws.Cells(1, 2) = 1
    
    For k = 2 To fin_line
        If ws.Cells(k, 1) <> ws.Cells(k - 1, 1) Then
            ws.Cells(k, 2) = 1
        Else
            ws.Cells(k, 2) = ws.Cells(k - 1, 2) + 1
        End If
    Next k
End Sub

---

mayu-さんのを借りるとこんな風にもできそうです。

Sub sample()
    With ThisWorkbook.Worksheets(1).UsedRange.Resize(, 1).Offset(, 1)
        .Value = 1
        .Resize(.Rows.Count - 1).Offset(1).FormulaR1C1 = "=IF(R[-1]C[-1]=RC[-1],R[-1]C+1,1)"
        .Value = .Value
    End With
End Sub

Comments

[dmg]

申し訳ございません。
本当はシートにに出力しよう思っていたので、コードが残っておりました。
失礼いたしました

ws.Cells(k, 2) = ws.Cells(k - 1, 2) + 1　
こちらで型が一致しませんになります

[jinoji]

シートの何行目で起きますか？
F8キーでステップ実行してみてください。

[dmg]

シートの２行目
連番になるところです。
A列の値を変えて再度行ってみましたが、連番になると止まってしまいます

[jinoji]

数字を変えてみました、とはどういう意味ですか？
画像の通りのシートになっていますか？

[dmg]

失礼いたしました
数字ではなく値をでした。

今は画像通りに戻しております

[dmg]

すみませんできました！
ありがとうございました！
お手を煩わせて申し訳ございません。

Answer 2

画像のようにA列を対象に、Aの値が下の値と同じ場合に
B列の数字を連続で入れるコードを書きたいです。

ご提示いただいたデータサンプル画像、念のために確認しますけど
A8セルの値が ABC になる場合、B8セルの値は( 登場回数の3ではなく )1でいいのですよね。

Sub sample()
    Dim ws1 As Excel.Worksheet
    Set ws1 = ThisWorkbook.Worksheets(1)
    
    Dim fin_line As Long
    With ws1.UsedRange
        fin_line = .Rows(.Rows.Count).Row
    End With
    If (fin_line < 2) Then Exit Sub
    
    ws1.Range("B1").Value = 1
    With ws1.Range("B2").Resize(fin_line - 1)
        .FormulaR1C1 = "=IF(RC[-1] <> R[-1]C[-1], 1, R[-1]C + 1)"
        .Value = .Value
    End With
End Sub

Comments

[dmg]

ご回答ありがとうございます。
全て１になってしまいました。。

[mayu-]

おや。
jinojiさんも仰っていますけど、シートのA列にサンプル画像どおりのデータが記入されているでしょうか。
ご確認お願いいたしますね。

[dmg]

mayu-様のコードでは期待結果が得られなかったです。。

[mayu-]

そうですか、残念です。
私はお力になれませんでしたけど、jinojiさんのアドバイスで解決できたようですし良かったですね。