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

VBAを100本の練習問題で鍛えます
公開日:2020-12-02 最終更新日: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 ・・・新着記事一覧を見る

TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.条件分岐(Select Case)|VBA入門
9.メッセージボックス(MsgBox関数)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




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


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


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