オートフィルタ抽出データに連番をつけるマクロ

質問

オートフィルタで抽出したデータに連番をふりたいと思っています。このサイトで調べた結果、オートフィルタをかけてのオートフィルでの連番入力はできないと知りました。
現在しようとしているのは
　　A　　B　　C
1　クラス　NO　氏名　　
2　1　　　　○△
3　2　　　　□×
4　1　　　　★♪
というデータがあり、項目にオートフィルタをかけている状態です。クラスを抽出した場合にそのクラスでの通し番号(連番)を付けたいのです。SUBTOTAL関数だと、連番が表示されるのはオートフィルタで抽出している間だけです。SUBTOTALでつけられた連番を、オートフィルタを解除しても残しておくにはどうしたらよいでしょうか。やはりコピー＆ペーストしかないのでしょうか？似たような質問が多々ありますが、コピー＆ペースト以外の方法をご存知の方、どうか教えて下さい。

回答No.3

zap35 · ベストアンサー

＃０１です
＞したがってオートフィルタで抽出を解除すれば同じ通し番号がクラス数分あることになります。
これは最初から書いていただきたかったですが(^^;、それならこのようなマクロでもできます。なお＃０２さんのご指摘のようにSpecialCellsを用いる方が処理が速くなりますが、手抜きして元のマクロを修正するにとどめます。

Sub Macro4()
Dim idx, cnt As Long
Application.ScreenUpdating = False
For idx = 2 To Range("A65536").End(xlUp).Row
　　If Rows(idx).Hidden = False Then
　　　　cnt = cnt + 1
　　　　Cells(idx, "B").Value = cnt
　　End If
Next idx
Application.ScreenUpdating = True
End Sub

お礼

説明がたりず分かりにくくてすみません。助かりました。
ありがとうございまあした。

回答No.2

anotherone

http://www.moug.net/skillup/nksw/nksw02-01.htm
.SpecialCells(xlCellTypeVisible)
フィルタ後に　表示されているセルだけ選択する時は
可視セル　を選択することをすすめます
全ての行を処理すると時間がかかりますが
可視セルなら検索結果のセルだけ処理できます

フィルタ後
for each myR in range("A1:A500").SpecialCells(xlCellTypeVisible)
msgbox myR.value
next

最終行 = Range("A" & activesheet.rows.count).End(xlUp).Row
65536行以上のシートでも共通で使うことができます

お礼

ありがとうございます。とても役に立ちました！！

回答No.1

zap35

表示されている行のB列に連番を振るマクロサンプルです。
質問文からではどのような使い方をするのかが分かりませんし、前に振った通し番号はどうすればよいのかもわかりません。ですから期待通りの動きはしないかもしれませんが、とりあえずヒントにはなるかもしれません

以下のマクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はワークシート画面に戻ってALT＋F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

Sub Macro4()
Dim idx, cnt As Long
For idx = 2 To Range("A65536").End(xlUp).Row
　　If Rows(idx).Hidden Then
　　　　Cells(idx, "B").ClearContents
　　Else
　　　　cnt = cnt + 1
　　　　Cells(idx, "B").Value = cnt
　　End If
Next idx
End Sub

補足

使い方としては、氏名にクラス番号を割り振った後、そのクラスごとにオートフィルタで抽出し、マクロで通し番号をつけるといった使い方です。なので、つけた通し番号はそのまま残したいと思います。したがってオートフィルタで抽出を解除すれば同じ通し番号がクラス数分あることになります。