VBA100本ノック 9本目：フィルターコピー

公開日：2020-10-27　最終更新日：2021-06-06

VBA100本ノック 9本目：フィルターコピー

データを絞り込んで別シートにコピーする問題です。
成績表から合格者の氏名だけを別シートに列挙します。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

#VBA100本ノック 9本目
「成績表」シートに5教科の成績とG列に合否判定があります。
「合格者」シートを新規作成し、合格者の氏名だけをA列に列挙してください。
※点数は非公開なので「合格者」シートには間違っても出力しないでください。
※何度でも実行できるようにしてください。

サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_09.xlsm
https://excel-ubara.com/vba100sample/VBA100_09.zip

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

データの絞り込みにはオートフィルターが便利です。
使用する上ではいくつか注意点がありますが、VBA記述が簡単であり、速度も速いので是非習得してください。
手動でオートフィルターで絞り込みされている場合もあるので、最初にオートフィルターを解除しています。


  
    
      Sub VBA100_09_01()

　　Dim wsIn As Worksheet

　　Dim wsOut As Worksheet

　　

　　On Error Resume Next

　　Application.DisplayAlerts = False

　　Worksheets("合格者").Delete

　　Application.DisplayAlerts = True

　　On Error GoTo 0

　　

　　Set wsIn = Worksheets("成績表")

　　Set wsOut = Worksheets.Add(After:=wsIn)

　　wsOut.Name = "合格者"

　　

　　wsIn.AutoFilterMode = False

　　With wsIn.Range("A1").CurrentRegion

      　　　　.AutoFilter Field:=7, Criteria1:="合格"

　　　　.Columns(1).Copy wsOut.Range("A1")

　　End With

　　wsIn.AutoFilterMode = False

End Sub

「合格者」シートはどうせ削除するならOn Errorを設定した上でとにかく削除してしまえ、という発想にしています。
もちろん、ループで確認したほうが良いとは思います。
こちらはシートがあればそれを活用し無ければ挿入するFunctionのサンプルです。
※名前の妥当性はチェックしていません。


  
    
      Function getSheet(ByVal Name As String, _

　　　　　　　　　Optional ByVal Before As Object, _

　　　　　　　　　Optional ByVal After As Object) As Worksheet

　　For Each getSheet In Worksheets

　　　　If getSheet.Name = Name Then

　　　　　　getSheet.Cells.Clear

　　　　　　Exit Function

　　　　End If

　　Next

　　

　　If Not Before Is Nothing Then

　　　　Set getSheet = Worksheets.Add(Before:=Before)

　　ElseIf Not After Is Nothing Then

　　　　Set getSheet = Worksheets.Add(After:=After)

　　Else

　　　　Set getSheet = Worksheets.Add

　　End If

　　

　　getSheet.Name = "合格者"

End Function

前ツイートのFunctionを使いオートフィルター以外で合格者氏名を抽出するVBAサンプルを補足に掲載しました。

補足

手動でオートフィルターをかけていた場合、AutoFilterを使うと元のフィルター状態が消えてしまいます。
手動のオートフィルターの状態を保存しておいて後で回復させようなどとは考えない方が良いでしょう。
VBA作成の労力が見合うとは思えません。
どうしてもオートフィルターを解除したくないのであれば、別の方法を検討してください。
シートをコピーしてコピー先のシートでAutoFilterを使うとか、
以下のようにAutoFilterを使わずに抽出する方法を検討してください。

エクセルVBAでは基本中の基本です。
「成績表」シートを上から順にみていき、「合格」のA列の氏名を「合格者」シートに順にコピーします。


  
    
      Sub VBA100_09_02()

　　Dim wsIn As Worksheet

　　Dim wsOut As Worksheet

　　Set wsIn = Worksheets("成績表")

　　Set wsOut = getSheet(Name:="合格者", After:=wsIn)

　　

　　Dim ary

　　ary = wsIn.Range("A1").CurrentRegion

　　

　　Dim i As Long, j As Long

　　wsOut.Range("A1") = "氏名"

　　j = 1

　　For i = LBound(ary) + 1 To UBound(ary)

　　　　If ary(i, 7) = "合格" Then

　　　　　　j = j + 1

　　　　　　wsOut.Cells(j, 1) = wsIn.Cells(i, 1)

　　　　End If

　　Next

End Sub

aryは2次元ですが、LBound,UBoundでは次元数を省略しているので1が指定されたものとなります。

速度対策としては配列を使うのが良いでしょう。
以下は、配列を使った少し変わった方法で書いてみました。


  
    
      Sub VBA100_09_03()

　　Dim wsIn As Worksheet

　　Dim wsOut As Worksheet

　　Set wsIn = Worksheets("成績表")

　　Set wsOut = getSheet(Name:="合格者", After:=wsIn)

　　

　　Dim ary1, ary2

　　ary1 = Intersect(wsIn.Range("A1").CurrentRegion, wsIn.Columns("A"))

　　ary2 = Intersect(wsIn.Range("A1").CurrentRegion, wsIn.Columns("G"))

　　

　　Dim i As Long

　　For i = LBound(ary2) + 1 To UBound(ary2)

　　　　If ary2(i, 1) <> "合格" Then

　　　　　　ary1(i, 1) = ""

　　　　End If

　　Next

　　

　　wsOut.Range("A1").Resize(UBound(ary1) - LBound(ary1) + 1) = ary1

　　On Error Resume Next

　　wsOut.Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

End Sub

先のFunctionではシート名の妥当性チェックを行っていません。
挿入可能なシート名の判定はかなり面倒です。

新規挿入可能なシート名の判定｜VBA技術解説

・シート名として使える文字列か判定・シートの存在確認：存在すればシートのオブジェクトを返す・シートの挿入：存在すればシートのオブジェクトを返す

サイト内関連ページ

第65回．シートの挿入、名前の変更（Add,Name）｜VBA入門

・シートの挿入・シートの名前変更・シート挿入、名前変更の実践例

第66回．シートのコピー・移動・削除Copy,Move,Delete）｜VBA入門

・シートのコピー・移動・シートの削除・シートのコピー・移動・削除の関連記事

第89回．オートフィルタ（AutoFilter）｜VBA入門

・Range.AutoFilterメソッド・AutoFilterModeプロパティ・AutoFilterオブジェクト・オートフィルタのVBA使用例・日付のフィルタ・オートフィルタまとめ

第106回．Functionプロシージャー｜VBA入門

プログラム（マクロVBA）内で特定の処理を実行し値を返すプロシージャーです。これはつまり、Functionプロシージャーで独自の関数をつくれるということです。Subプロシージャーとの違いは、値を返すか返さないかの違いです。

第107回．プロシージャーの引数｜VBA入門

・引数の構文・引数の使用例・引数について

第111回．静的配列｜VBA入門

・配列とは・静的配列と動的配列・配列の宣言・多次元配列・要素の下限の変更・配列について

第112回．動的配列（ReDim）｜VBA入門

・ReDimステートメント・要素数の変更について・配列について

第113回．配列に関連する関数

・LBound関数とUBound 関数・Array関数・IsArray 関数・Join関数・Filter関数・Eraseステートメント

同じテーマ「VBA100本ノック」の記事

6本目：セルに計算式
 7本目：日付データの扱い
 8本目：点数の合否判定
9本目：フィルターコピー
10本目：行の削除
 11本目：セル結合の警告
 12本目：セル結合を解除
 13本目：文字列の部分フォント
 14本目：社外秘シート削除
 15本目：シートの並べ替え
 16本目：無駄な改行を削除

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
9本目：フィルターコピー

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

VBA練習問題
VBA100本ノック 9本目：フィルターコピー