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

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

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


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


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

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


出題

出題ツイートへのリンク

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

マクロ VBA 100本ノック

マクロ VBA 100本ノック


頂いた回答

解説

扱うシート数が多いだけで、やることは条件に合致する行をコピーして他のシートに貼り付けるだけになります。
方法として、
・オートフィルタを使用する
・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入門では、アクティブブックのアクティブシートだけを扱ってきました。アクティブブックのアクティブシートとは、一番手前に表示されているブックの選択しているシートで、通常、手作業で操作しているシートの事になります。手作業では、アクティブブックのアクティブシートしか扱えませんが、(作業グループで複数のシートに同時に操作するのは別の話として) VB…
第39回.セルのクリア(Clear,ClearContents)
セルをクリアするマクロVBAの書き方です、クリアするといっても、セルの何を(値、色、コメント等々)クリアするかによって、VBAコードが違ってきます。具体的には、セルの何を(値、色、コメント等々)クリアするかによって使用するメソッドが変わるという事です。
第46回.VBA関数(日付,DateAdd)
データ型の中でも日付時刻はかなり特殊であり、関数の使用は必要不可欠になります。ここでは、日付に関するVBA関数の一覧と、DateAdd関数について解説します。DateAdd関数以外の他の関数は、一覧のリンクより個別のページを参照して下さい。
第51回.Withステートメント
Withステートメントを使う事で、Withに指定したオブジェクトに対してオブジェクト名を再度記述することなく、プロパティやメソッドを記述することができます。文章で例えて言えば、主語を一度書いたら、その後は主語を省略するような書き方になります。
第52回.オブジェクト変数とSetステートメント
変数のデータ型の説明において、Object…オブジェクト型 というのがあった事を覚えているでしょうか。数値や文字ではなく、オブジェクトを入れる変数がオブジェクト変数です。オブジェクトと言っても、いろいろなものがあります。
第55回.Worksheetオブジェクト
Worksheetオブジェクトは、ワークシートそのものです。エクセルのマクロVBAですから、ワークシートはしっかりと扱えなければなりません。WorkSheetオブジェクトの集まりがWorkSheetsコレクションになります。
第87回.WorksheetFunction(ワークシート関数を使う)
VBA関数以外に、Excelワークシート関数をマクロVBAで使うことが出来ます、ワークシート関数は、VBA関数よりはるかに多くの関数があるので、ぜひ活用したいところです。。ワークシート関数を使う事で、VBAコードを非常に簡潔に記述することが出来る場合が多いものです。
第89回.オートフィルタ(AutoFilter)
オートフィルタはExcelのデータベースとしての非常に強力な機能を提供してくれています、VBAで、必要なデータだけに絞り込んで他のシートにコピーしたり、不要なデータを一括で削除したりする場合は、とても高速に処理することができます。VBAでオートフィルタを操作するには、以下のメソッド・プロパティおよびオブジェクトを使用します。




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

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


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

VBA100本ノック 68本目:全テキストボックスの転記|VBA練習問題(1月16日)
VBA100本ノック 67本目:ComboBoxとListBox|VBA練習問題(1月15日)
VBA100本ノック 66本目:全サブフォルダからファイルを探す|VBA練習問題(1月13日)
VBA100本ノック 65本目:固定長テキスト出力|VBA練習問題(1月12日)
VBA100本ノック 64本目:リンクされた図(カメラ機能)|VBA練習問題(1月11日)
VBA100本ノック 63本目:複数シートの連結|VBA練習問題(1月9日)
VBA100本ノック 62本目:独自のZLOOKUP関数を作成|VBA練習問題(1月8日)
VBA100本ノック 61本目:「ふりがな」の取得と設定|VBA練習問題(1月6日)
VBA100本ノック 60本目:「株式会社」の表記ゆれ置換|VBA練習問題(1月5日)
VBA100本ノック 59本目:12ヶ月分のシートを四半期で分割|VBA練習問題(1月4日)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.繰り返し処理(For Next)|VBA入門
7.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.繰り返し処理(Do Loop)|VBA入門




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


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



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