エクセルで重複するセルの出現回数を数えたい

質問

エクセル2003である列で重複するセルの出現回数を別の列にカウントするマクロの書き方を教えて下さい．

具体的には以下の通りです．
A列が実データで，B列に出現回数をカウントする例．

A列　　　B列
12345　　
33456
12345
99999
12345
・
・
・

に対してマクロ実行すると，
A列　　　B列
12345　　1　　
33456 1
12345 2
99999 1
12345 3
・
・
・

大体1000行ほどのデータがあります．
よい方法があれば教えていただけると大変ありがたいです．

回答No.1

Cupper · ベストアンサー

関数ではダメ？

　B1 =COUNTIF(A$1:A1,A1)
B1以下にコピー

これでOK
1000行あるなら、左上の名前ボックスに B1:B1000 と入力すると
B1から B1000セルまでを選択してくれますので、
Ctrlキーを押しながら Dキーを押すと一発で B1の内容が範囲にコピーされます

お礼

つい、勢いでマクロと書いてしまいました。関数でも問題なかったでです。ほかのマクロを教えていただいた方もありがとうございました。

上記の関数でいとも簡単にできてしまいました。
さらに複数行選択する技術まで教えていただけました。感謝いたします。

回答No.6

a987654

関数でも可能ですがどうしてもマクロなら１例として

オーソドックスなやり方で、２０００行まで余裕をみて、
Ａ１セルから始まり最終データの次行は
空白（ブランクではなくDELする）としています。

表示上は同じでも文字と数値は区別されます。
そのままのベタ張りで動くことは確認済で、特殊なものは使って
いないのでエクセルのバージョンには影響されません。

もとはインデントしてあるのですが投稿時に詰まってしまい
見にくくなっているのはご容赦願います。
下記　ご参考まで

For i = 1 To 2000
If (Cells(i, 1) = "") Then Exit For '最終行判定
Cells(i, 2) = 0 '初期値設定
Next i

For i = 1 To 2000
a$ = Cells(i, 1)
If (a$ = "") Then Exit For '最終行判定
ii = 1
If (Cells(i, 2) = 0) Then Cells(i, 2) = ii

For j = i + 1 To 2000
If (Cells(j, 2) > 0) Then Exit For '記入済回避
b$ = Cells(j, 1)
If b$ = "" Then Exit For '最終行判定
If (a$ = b$) Then
ii = ii + 1
Cells(j, 2) = ii 'カウント値記入
End If
Next j

Next i

お礼

質問内容が、マクロで、
ということでしたので、マクロで回答いただきありがとうございます。
ただ、初期目的は関数で簡単に達成できました。
今後、エクセルを勉強していきたいと思いますので、
また壁にぶち当たったら質問させてください。
ありがとうございました。

回答No.5

n-jun

No.4です。

間違えたのでスル～して下さい。

回答No.4

n-jun

Sub try()
　With Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　.Offset(, 1).Formula = "=COUNTIF($A$1:" & .Address(1, 1) & ",A1)"
　　　.Offset(, 1).Value = .Offset(, 1).Value
　End With
End Sub

一例まで。

回答No.3

KURUMITO

間違いでした。次のようにします。
Sub Macro2()
Range("B1").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",COUNTIF(R1C[-1]:RC[-1],RC[-1]))"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B1500"), Type:=xlFillDefault
Range("B1:B1500").Select
Range("C1").Select
End Sub

お礼

質問内容が、マクロで、
ということでしたので、マクロで回答いただきありがとうございます。
ただ、初期目的は関数で簡単に達成できました。

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

回答No.2

KURUMITO

たとえば次のようにします。

Sub Macro1()
Range("B1").Activate
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",COUNTIF(C[-1],RC[-1]))"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B1500"), Type:=xlFillDefault Range("A1").Select
End Sub