VBA100本ノック 38本目：1シートを複数シートに振り分け

公開日：2020-12-02　最終更新日：2021-02-22

VBA100本ノック 38本目：1シートを複数シートに振り分け

1シートを複数シートに振り分ける問題です。
「土日祝」と「平日」でシートを分けます。

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

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

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

出題

#VBA100本ノック 38本目
「売上」シートのA列に日付が昇順で入っています。
土日祝と平日に分けて別シートに出力してください。
・「売上」シートの列数は不定。
・「土日祝」「平日」シートは既存です。
・祝日は「祝日」シートのA列にあります。
※セルの書式の扱いは任意

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

VBA作成タイム

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

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

頂いた回答

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

解説

扱うシート数が多いだけで、やることは条件に合致する行をコピーして他のシートに貼り付けるだけになります。
方法として、
・オートフィルタを使用する
・1行ずつ判定していく
このどちらかになります。
まずは、こういう場合の定番のオートフィルタから、


  
    
      Sub VBA100_38_01()

　　Dim ws売上 As Worksheet:　　Set ws売上 = Worksheets("売上")

　　Dim ws土日祝 As Worksheet:　Set ws土日祝 = Worksheets("土日祝")

　　Dim ws平日 As Worksheet:　　Set ws平日 = Worksheets("平日")

　　

　　ws平日.Cells.Clear

　　ws土日祝.Cells.Clear

　　

　　Dim myRange As Range

　　Dim calcCol As Long

　　Set myRange = ws売上.Range("A1").CurrentRegion

　　calcCol = myRange.Columns.Count + 1

　　

　　myRange.Columns(calcCol) = "=IF(OR(WEEKDAY(A1,2)>=6,COUNTIF(祝日!A:A,売上!A1)>0),1,0)"

　　ws売上.AutoFilterMode = False

　　ws売上.Range("A1").AutoFilter Field:=calcCol, Criteria1:=0

　　myRange.SpecialCells(xlCellTypeVisible).Copy Destination:=ws平日.Range("A1")

　　ws売上.Range("A1").AutoFilter Field:=calcCol, Criteria1:=1

　　myRange.SpecialCells(xlCellTypeVisible).Copy Destination:=ws土日祝.Range("A1")

　　ws売上.AutoFilterMode = False

　　myRange.Columns(calcCol).ClearContents

End Sub

判定すべき条件が既存のデータだけでは足りない場合は、適宜作業列を使って導出してください。
1行ずつ判定しながら1行ずつコピーする場合と、これでは件数が多いと時間がかかるのでUnionを使う方法。
これらは、記事補足に掲載しました。

補足

先のVBAで数式を入れている部分ですが、
1行目から数式を入れていますが、1行目は特に使用しないので一緒に入れてしまっているだけで、特に意味はありません。
、ここで使った数式ですが、
=IF(OR(WEEKDAY(A1,2)>=6,COUNTIF(祝日!A:A,売上!A1)>0),1,0)
これは、
=NETWORKDAYS(A1,A1,祝日!A:A)
このようにNETWORKDAYS関数で簡単にすることができます。
ただし、この場合は「祝日」のA列は日付だけにするか、日付範囲だけを参照するように指定してください。

以下は、1行ずつ判定する場合のVBAのサンプルです。
1行ずつコピーする方法の場合、件数が多くなると処理時間がかかってしまいます。
そこで、Unionを使って一括コピーすることで処理速度を速くすることができます。

1行ずつ判定し1行ずつコピする


  
    
      Sub VBA100_38_02()

　　Dim ws売上 As Worksheet:　　Set ws売上 = Worksheets("売上")

　　Dim ws土日祝 As Worksheet:　Set ws土日祝 = Worksheets("土日祝")

　　Dim ws平日 As Worksheet:　　Set ws平日 = Worksheets("平日")

　　

　　ws平日.Cells.Clear

　　ws土日祝.Cells.Clear

　　ws売上.Rows(1).Copy Destination:=ws平日.Rows(1)

　　ws売上.Rows(1).Copy Destination:=ws土日祝.Rows(1)

　　

　　Dim ws As Worksheet

　　Dim i As Long, j As Long

　　With ws売上

　　　　For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row

　　　　　　If Weekday(.Cells(i, 1), vbMonday) >= 6 Or _

　　　　　　　 WorksheetFunction.CountIf(Worksheets("祝日").Columns(1), .Cells(i, 1)) > 0 Then

　　　　　　　 Set ws = Worksheets("土日祝")

　　　　　　Else

　　　　　　　　Set ws = Worksheets("平日")

　　　　　　End If

　　　　　　j = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

　　　　　　.Rows(i).Copy Destination:=ws.Rows(j)

　　　　Next

　　End With

End Sub

1行ずつ判定しUnionして最後に一括コピー


  
    
      Sub VBA100_38_03()

　　Dim ws売上 As Worksheet:　　Set ws売上 = Worksheets("売上")

　　Dim ws土日祝 As Worksheet:　Set ws土日祝 = Worksheets("土日祝")

　　Dim ws平日 As Worksheet:　　Set ws平日 = Worksheets("平日")

　　

　　ws平日.Cells.Clear

　　ws土日祝.Cells.Clear

　　

　　Dim rng平日 As Range, rng土日祝 As Range

　　Dim ws As Worksheet

　　Dim i As Long, j As Long

　　With ws売上

　　　　Set rng平日 = .Rows(1)

　　　　Set rng土日祝 = .Rows(1)

　　　　For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row

　　　　　　If Weekday(.Cells(i, 1), vbMonday) >= 6 Or _

　　　　　　　 WorksheetFunction.CountIf(Worksheets("祝日").Columns(1), .Cells(i, 1)) > 0 Then

　　　　　　　　Set ws = Worksheets("土日祝")

　　　　　　　　Set rng土日祝 = Union(rng土日祝, .Rows(i))

　　　　　　Else

　　　　　　　　Set ws = Worksheets("平日")

　　　　　　　　Set rng平日 = Union(rng平日, .Rows(i))

　　　　　　End If

　　　　Next

　　End With

　　rng平日.Copy Destination:=ws平日.Rows(1)

　　rng土日祝.Copy Destination:=ws土日祝.Rows(1)

End Sub

サイト内関連ページ

第37回．ブック・シートの指定

・マクロVBAでのブック・シート指定の具体例・マクロVBAでのブック・シート指定の必要性・VBAでの色々なシート指定方法

第39回．セルのクリア（Clear,ClearContents）

・セル(Rangeオブジェクト)のクリア関係のメソッド（動作を与える）・Range.Clear ・Range.ClearContents ・クリア関係メソッドについて

第46回．VBA関数（日付,DateAdd）

・日付時刻に関するVBA関数の一覧・DateAdd関数の構文・DateAdd関数の使用例

第51回．Withステートメント

・Withの構文・Withを使った時と使わない時の比較・Withの使用例・Withのネスト・Withを使ったときに気を付けるべき書き方・Withの使いどころ・サイト内の参考ページ

第52回．オブジェクト変数とSetステートメント

・オブジェクト変数・個有のオブジェクト型とは・Setステートメント・Setステートメントの使用例・WithとSetの使い分け方・Setステートメントの実践的な使い方・Is演算子によるオブジェクトの比較・最後に

第55回．Worksheetオブジェクト

・WorkSheetオブジェクトの指定方法・Worksheetオブジェクトデータ型・WorkSheetのプロパティとメソッド・Worksheetオブジェクトの使用方法・Activesheet、Sheetsコレクションについて

第87回．WorksheetFunction（ワークシート関数を使う）

・ワークシート関数の使い方・WorksheetFunctionで使用できる関数・個別の関数の使い方・関数の結果（戻り値）・WorksheetFunctionの使用例．・検索系の関数での日付の扱い・WorksheetFunctionのエラー対処・最後に

第89回．オートフィルタ（AutoFilter）

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

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

35本目：条件付き書式
 36本目：列の並べ替え
 37本目：グラフの色設定
38本目：1シートを複数シートに振り分け
39本目：数値リストの統合（マージ）
40本目：複数ブックの統合
 41本目：暗算練習アプリ
 42本目：データベース形式に変換
 43本目：CSV出力
 44本目：全テーブル一覧作成
 45本目：テーブルに列追加

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
38本目：1シートを複数シートに振り分け

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

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 38本目：1シートを複数シートに振り分け