38本目 1シートを複数シートに振り分け

VBA100本ノック

VBA100本ノック 38本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ


問題

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

解答

Sub test()

    Dim ws売上 As Worksheet:     Set ws売上 = Sheets("売上")
    Dim ws土日祝 As Worksheet: Set ws土日祝 = Sheets("土日祝")
    Dim ws平日 As Worksheet:     Set ws平日 = Sheets("平日")
    Dim ws祝日 As Worksheet:     Set ws祝日 = Sheets("祝日")
    
    Dim rng As Range
    Dim 作業cl As Long
    Set rng = ws売上.Range("A1").CurrentRegion
    作業cl = rng.Columns.Count + 1
    rng.Columns(作業cl) = "=IF(OR(WEEKDAY(A2,2)>=6,COUNTIF(祝日!A:A,A2)=1),""土日祝"",""平日"")"
    
    ws売上.AutoFilterMode = False
    ws売上.Range("A1").AutoFilter Field:=作業cl, Criteria1:="土日祝", Operator:=xlFilterValues
    rng.SpecialCells(xlCellTypeVisible).Copy Destination:=ws土日祝.Range("A1")
    ws売上.Range("A1").AutoFilter Field:=作業cl, Criteria1:="平日", Operator:=xlFilterValues
    rng.SpecialCells(xlCellTypeVisible).Copy Destination:=ws平日.Range("A1")
    ws売上.AutoFilterMode = False
    
    rng.Columns(作業cl).ClearContents
    
End Sub
新人君
新人君

シートがいっぱいで
大変そうですね…

ブチョ
ブチョ

そう?
余裕のよっちゃんだろ!

新人君
新人君

ふるっ…

コメント

タイトルとURLをコピーしました