エクセルVBAで重複する名前に（2）、（3）等をつける方法は？

質問

こんにちは。お世話になります。
以下のようなデータ（約1500件）があります。
データは分類と名称でソート済みです。
同じ分類のなかで同じ「名称」があった場合、B列の名称の直後に同一セル内で（2）や（3）を順に振っていくマクロを教えていただきたいのです。（1）は不要です。
下記の例では、ううう(2)、ううう(3)といった具合です。
よろしくお願いします。

A列 B列 C列
分類 名称 データ1
aaa あああ a
aaa いいい b
aaa ううう a
aaa ううう a
aaa ううう a
aaa えええ b
bbb かかか a
bbb かかか a
bbb ききき a
bbb くくく b
ccc さささ a
ccc ししし b
ccc すすす a
ccc すすす a
ccc すすす a
ccc すすす a
ccc せせせ a

回答No.4

imogasi · ベストアンサー

Sub test01()
d = Range("a1").CurrentRegion.Rows.Count
' MsgBox d
'初回設定
m = Cells(1, "A") & Cells(1, "B") '直前キーにセット
r = 1
'２行目以後繰り返し
For i = 2 To d
n = Cells(i, "A") & Cells(i, "B") '比較キーを作る
If n = m Then '直前と同じか
'変らないとき
r = r + 1 '繰り返し回数を＋１
Cells(i, "D") = "'(" & Trim(Str(r)) & ")" '繰り返し回数セット
Else
'変ったとき－＞何もしない
r = 1 '繰り返し回数を１にセット
m = n '現在キーを直前キーにセット
End If
Next i
End Sub

お礼

大変ありがとう御座いました。
たすかりました。

回答No.3

sakenomo

すでに回答がでていますが、せっかく作ったので・・・。
１行目は見出し行としています。

＃２さんの回答は、たいへん勉強になります。ただ、Ｂ列の名称の文字列中に、数字を（）で囲んだものが入っていると、うまくいかない場合があります。

Sub test()
Dim c As Range, n As Long, p As Variant
n = 2
For Each c In Range("B2", Range("B65536").End(xlUp))
If c.Value = p Then
If c.Offset(0, -1).Value = c.Offset(-1, -1).Value Then
c.Value = p & "(" & n & ")"
n = n + 1
Else
n = 2
End If
Else
p = c.Value
n = 2
End If
Next
End Sub

お礼

ありがとうございました。

回答No.2

ja7awu

こんな感じで如何でしょうか。
１行目が見出しで、2行目からデータがあるとします。
Excel2000か、それ以降をお使いになっている場合です。

Sub test()
Dim Rng As Range
Dim N As Long
N = 1
For Each Rng In Range("B3", Range("B65536").End(xlUp))
　　If Rng.Value = Replace(Rng.Offset(-1), "(" & N & ")", "") And _
　　　　Rng.Offset(, -1).Value = Rng.Offset(-1, -1).Value Then
　　　　N = N + 1
　　　　If N > 1 Then Rng.Value = Rng.Value & "(" & N & ")"
　　Else
　　　　N = 1
　　End If
Next Rng
End Sub

お礼

ありがとう御座いました。

回答No.1

shishishishi

データが2行目からですべてソート済みだとして、「名称」の重複は最大100個までと仮定すれば以下で出来ます。

Sub test()
For n = 2 To Range("B1").CurrentRegion.Rows.Count
For x = 1 To 100
If Cells(n, "B").Value = Cells(n + x, "B").Value Then _
Cells(n + x, "B").Value = Cells(n, "B").Value & "(" & x + 1 & ")"
Next x
Next n
End Sub

1500件のデータとのことなので重複の最大を100にしてみましたが、範囲内で同一名称の個数を調べるVBAを組み合わせれば完璧になると思います。

お礼

ありがとうございました。
重複が最大いくらあるかはデータによりかわるので・・・・。