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

Question

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

zap35 · Accepted Answer

＃０１です
＞したがってオートフィルタで抽出を解除すれば同じ通し番号がクラス数分あることになります。
これは最初から書いていただきたかったですが(^^;、それならこのようなマクロでもできます。なお＃０２さんのご指摘のように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

anotherone · Answer

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行以上のシートでも共通で使うことができます

zap35 · Answer

表示されている行の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

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

＃０１です

表示されている行のB列に連番を振るマクロサンプルです。

この回答への補足

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング