エクセルＶＢＡと並び替え

質問

エクセル2007を勉強中です。

今、以下の画像左のようなデータのシート（シート1）を作成しました。

このシートをフリガナを基準に並び替えて、かつ、
重複する件数を画像右のように、シート2に抽出したいのです。

並び替えまでは自動記録機能でできたのですが
件数のカウントまでを自動でできればと思いました。

どんなコードにすればいいのでしょうか。

よろしくお願いします。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.3

bin-chan · ベストアンサー

Excelの機能に「小計」があるので、利用されてみては？（２００３までは「集計」）

データ＞集計です。

手動で結果を得るも良し、VBAの記録を行って組み込むも良し。

回答No.2

imogasi

関数を混ぜた回答が出ているが、他のやり方を１つ。
例データ
Ａ列　　　Ｂ列（ＶＢＡ実行後の結果）
氏名　　　件数
a ＜－第２行目から実データ
a
a 3
b
b 2
c
c
c 3
ーー
標準モジュールに
Sub test01()
'データはＡ列でソートされていること
d = Range("A65536").End(xlUp).Row 'Ａ列最終行取得
m = Cells(2, "A") 'データの最初の行のデータ:
c = 1 '件数は最初行分をとりあえず１
'--
For i = 3 To d '
'最終行まで繰り返し
If Cells(i, "A") = m Then '直前行と同じなら
c = c + 1
Else
'超然行と変わったら、件数カウントを結果書き出し
Cells(i - 1, "B") = c
c = 1 '現在行分として１
End If
m = Cells(i, "A") '直前行文字列を次の行に使うため置着替え
Next i
Cells(i - 1, "B") = c '最後の戸じまい
End Sub
この手法は今後どこかで役立つよ。

回答No.1

keithin

＞並び替えまでは自動記録機能でできたのですが

この続きに
サンプル１：
worksheets("Sheet2").range("C1:C" & range("A65536").end(xlup).row).formula = "=IF(A1=A2,"""",COUNTIF(A:A,A1))"

サンプル２：
worksheets("Sheet2").range("C1:C" & range("A65536").end(xlup).row).formula = "=IF(A1=A2,NA(),COUNTIF(A:A,A1))"
on error resume next
worksheets("Sheet2").range("C:C").specialcells(xlcelltypeformulas, xlerrors).clearcontents
on error goto 0

などのように続けてみます。

必要に応じて
worksheets("Sheet2").range("C:C").numberformatlocal = "0件"
のように表示を整えます。