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

VBAを100本の練習問題で鍛えます
最終更新日:2021-02-22

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


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


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

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。


出題

出題ツイートへのリンク

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

マクロ VBA 100本ノック

マクロ VBA 100本ノック


サンプルファイルです。
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本目:テーブルに列追加


新着記事NEW ・・・新着記事一覧を見る

構成比を合計しても100%にならないと言われた…|ツイッター出題回答 (2022-09-01)
一覧から複数条件(部分一致、範囲)に合致するデータを抽出する|ツイッター出題回答 (2022-08-30)
縦横スピルしないXLOOKUP代替(MATCH+INDEX,FILTER,CHOOSEROWS)|エクセル入門(2022-08-27)
IF関数の論理式で比較演算子を省略したCOUNT系関数を書くのは|ツイッター出題回答 (2022-08-23)
LAMBDA以降の新関数の使用例|エクセル入門(2022-08-22)
数珠順列(配置に条件付き)を全て出力する|ツイッター出題回答 (2022-08-20)
日付時刻のマイナス表示に対応する方法|ツイッター出題回答 (2022-08-17)
LAMBDA以降の新関数について|エクセル入門(2022-08-16)
条件付きの最大値と中央値("A"が2文字の条件)|ツイッター出題回答 (2022-08-14)
VBAマクロと操作対象データの分離について|ツイッター出題回答 (2022-08-11)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Excelショートカットキー一覧|Excelリファレンス
7.並べ替え(Sort)|VBA入門
8.マクロって何?VBAって何?|VBA入門
9.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
10.エクセルVBAでのシート指定方法|VBA技術解説




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


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



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