エクセルVBAで1ヶ月のシフト表から日曜日を除いた表を作成したい

毎週日曜日が休日の職場でシフト表を作成しています。
元の表は残したまま元の表の数段下に曜日に「日」とつく列のセルを削除して左詰めにした表を作成したいです。

空白セルの左詰めのマクロはたくさんあったのですが、指定した文字を含む列をのセルを左詰めにするマクロがみつからなかったので、教えていただければと思います。

またシフト表が12月と1月のとき、日曜日以外の休日（12月は29日～31日、1月は1日～3日）も削除したいです。

よろしくお願いいたします。

No.7 回答者： tom04 回答日時： 2018/08/27 21:55

No.1・4・5です。

＞別シートにコピペではなく、元のシートの表が上書きされていましました。

No.5のコードは
元のシートを別シートにセル全体をコピー＆ペーストした後に
貼り付け先シートのシートモジュールにするコードです。
もしかして元のシートのシートモジュールにしていませんか？

今回はそういう間違いがないように元のシートをそのまま別シートにコピー＆ペーストするコードも追加してみました。
標準モジュールにしてください。

尚、「元のシート」のシート名は「Sheet1」で「Sheet2」で操作するようにしています。

Sub Sample2()
　Dim j As Long, c As Range, myRng As Range
　　With Worksheets("Sheet2") '//←「Sheet2」は実際のシート名に！★//
　　　.Cells.Clear
　　　Worksheets("Sheet1").Cells.Copy .Range("A1") '//←「Sheet1」の部分は実際のシート名に★//
　　　　With .Range("E5:AI6")
　　　　　.Value = .Value
　　　　End With
　　　　For j = 5 To .Cells(5, Columns.Count).End(xlToLeft).Column
　　　　　If .Cells(5, j) <> "" Then
　　　　　　If WorksheetFunction.Weekday(.Cells(5, j)) = 1 Then
　　　　　　　Set c = .Cells(5, j)
　　　　　　End If
　　　　　　If .Range("B5") = 1 Then
　　　　　　　If Day(.Cells(5, j)) <= 3 Then
　　　　　　　　Set c = .Cells(5, j)
　　　　　　　End If
　　　　　　End If
　　　　　　If .Range("B5") = 12 Then
　　　　　　　If Day(.Cells(5, j)) >= 29 Then
　　　　　　　　Set c = .Cells(5, j)
　　　　　　　End If
　　　　　　End If
　　　　　　If myRng Is Nothing Then
　　　　　　　Set myRng = c
　　　　　　Else
　　　　　　　Set myRng = Union(myRng, c)
　　　　　　End If
　　　　　End If
　　　　Next j
　　　　myRng.EntireColumn.Delete
　　　　.Activate
　　End With
End Sub

※　コード内にコメントを入れましたが、
各シート名は実際のシート名にしてください。m(_ _)m

この回答へのお礼

tom04さん

できました。
休日の設定をしなくても日曜日、年末年始が表示されないようにマクロでやって頂いてとても助かりました。
本当にありがとうございました。

お礼日時：2018/08/29 15:25

No.6 回答者： WindFaller 回答日時： 2018/08/27 06:53

No.3 の回答者です。

返事が、遅くなりました。

あくまでも、私の想像の範囲から進めたものですから、希望に合わない部分があるのは当然なのですが、こちらの誤解もあるのかもしれませんか、困ってしまいました。

私の場合は、基本的な表の役割からを話を進めないといけないのです。
どこまで、マクロでやらせるかですが、更新はご自身でされるのかどうかというのが最初のポイントです。

それと、元の表(上）と新たに作る表(下）の関係性です、私のマクロは、元の表から転記していくというスタイルであるということです。特別に数式などで連動させるようなことは考えていません。

>B4・B5セルに年・月を入力しても日付と曜日が変わらなくなってしまいました。

それは、考慮には入れています。単に、2箇所変えるだけで済みます。しかし、月の更新という操作が不要で、データもご自分で削除するのでしたら、 DateLists　マクロは不要なのです。

変更箇所は、
　E5 は、=DATE($B$4,$B$5,1)
　E6 も、数式コピーで　=DATE($B$4,$B$5,1)　を入れてください。
条件付き書式なども、残っています。
ただ、翌月の1日からも表示してしまいますので、条件付き書式などは加工しなくてはなりませんので、条件付き書式で、
AC5 辺りから、AI16 までの範囲を選択し、
　　=$B$5<MONTH(AC$5)
　　書式－フォント－白
で設定すれば、翌月の表示はしなくなります。
転記に関しては、今のところ、問題はないはすです。

SecondMekeListを、独立して動くように作っています。

二番目の表(下）は、あくまでも
SecondMakeList で、E19:右端の20行目は、上の表から、休日を抜いて転記したものです。

後は、お礼欄のご質問について
>呼び出せるようにとは具体的にどのような操作をするのでしょうか？

マクロ上で、ワークシート関数の「MATCH」関数で、その日は、休日(祭日や定休日、休み）であるか検査してしているのです。マクロに組み込まれていますから、操作自体はいりません。

"HOLIDAY"の文字がありますが、それが、リストと照らし合わせているのです。
.Resize(2).FormatConditions.Add(xlExpression, xlEqual, "=ISNUMBER(MATCH(RC,HOLIDAY,FALSE))=TRUE")

>＞なお、行末に「＊」がついているところは、位置を特定する部分ですから、位置が変わったら変更しなくてはなりません。
>すみません、この文章が理解できませんでした。

データが、19行目からというのは仮の話ですよね。だから、そこのアドレスを適宜、書き換えてくださいという意味なのです。

/'19行目から、日曜、祭日抜きで日付を入れる*　　←「アスタリスク」
/　　Cells(19, 5 + j).Resize(2 + ItemNO).Value = .Resize(2 + ItemNO).Value
　　　　　↑　転部画像では19行目からですが、26行目からなら、26と入れます。
/と同時に、
Const ItemNO As Long = 10 'データの行数 *　　←「アスタリスク」
ここのメンバー数も変わるはずです。

この回答へのお礼

WindFallerさん

ご回答、ありがとうございます。

＞更新はご自身でされるのかどうかというのが最初のポイントです。
私はこのフォーマットを作成したら他の者に引き継ぐつもりです。

＞元の表から転記していくというスタイルであるということです。
私もそのイメージで質問させて頂きました。

＞E5 は、=DATE($B$4,$B$5,1)
　E6 も、数式コピーで　=DATE($B$4,$B$5,1)　を入れてください。
E5（日付）とE6（曜日）に同じ数式を入れるのでしょうか？

＞SecondMekeListを、独立して動くように作っています。
ここまでの操作で「SecondMekeList」のみを実行しましたが、まったく同じ表がコピーされただけでした。

＞そこのアドレスを適宜、書き換えてくださいという意味なのです。
わかりました。
ご丁寧な説明、ありがとうございました。

お礼日時：2018/08/27 21:28

No.5 回答者： tom04 回答日時： 2018/08/26 22:05

No.1・4です。

＞日付の行が「=#REF!+1」になってしまいました。

F5セル以降は左側セルに「+1」となっているのですね。
そのためのエラーだと思います。
No.1で紹介した数式の場合はエラーにならないと思いますが、

元データのSheet全体を別シートにコピー＆ペーストしそのSheetの列削除を行うという前提のコードにしてみました。

Sub Sample1()
　Dim j As Long, c As Range, myRng As Range
　　'//▼E5～AI6セルを実データ（値）にする//
　　With Range("E5:AI6")
　　　.Value = .Value
　　End With
　　'//▲ココまで//
　　　For j = 5 To Cells(5, Columns.Count).End(xlToLeft).Column
　　　　If Cells(5, j) <> "" Then
　　　　　If WorksheetFunction.Weekday(Cells(5, j)) = 1 Then
　　　　　　Set c = Cells(5, j)
　　　　　End If
　　　　　If Range("B5") = 1 Then
　　　　　　If Day(Cells(5, j)) <= 3 Then
　　　　　　　Set c = Cells(5, j)
　　　　　　End If
　　　　　End If
　　　　　If Range("B5") = 12 Then
　　　　　　If Day(Cells(5, j)) >= 29 Then
　　　　　　　Set c = Cells(5, j)
　　　　　　End If
　　　　　End If
　　　　　If myRng Is Nothing Then
　　　　　　Set myRng = c
　　　　　Else
　　　　　　Set myRng = Union(myRng, c)
　　　　　End If
　　　　End If
　　　Next j
　　myRng.EntireColumn.Delete
End Sub

※　No.3さんが回答されているように「祝日」を考慮する必要がある場合は
もう一つ「祝日」の条件を追加すれば対応できます。

※　5行目のシリアル値は大の月・小の月の考慮が必要なのでは？
No.1の数式はその辺を考慮した数式です。m(_ _)m

この回答へのお礼

tom04さん

ご回答、ありがとうございます。

＞元データのSheet全体を別シートにコピー＆ペーストしそのSheetの列削除を行うという前提のコードにしてみました。
別シートにコピペではなく、元のシートの表が上書きされていましました。
これだと次の月に使えないので困ります。。。

ただ12月と1月も試しましたが、問題なくできました。

お礼日時：2018/08/27 20:56

No.4 回答者： tom04 回答日時： 2018/08/26 21:24

No.1です。

＞コピー後のシフト表の日曜日のみを削除して左に詰めたいのです。

というコトなので、前回の「Sample1」のコードの
＞myRng.EntireColumn.Hidden = True
の1行だけを
＞myRng.EntireColumn.Hidden = True
を

＞myRng.EntireColumn.Delete
に変更してみてください。

※　当然その前のChangeイベントのコードは不要です。m(_ _)m

この回答へのお礼

tom04さん

ご回答ありがとうございます。

早速やってみましたが、日付の行が「=#REF!+1」になってしまいました。
また元の表は残したまま、コピーした表の日曜日の列を左に詰めたいです。
（毎月使用するためです。）

お礼日時：2018/08/26 21:38

No.2 回答者： d-q-t-p 回答日時： 2018/08/25 08:53

範囲を選択してコピーし 別シートに[行列を入れ替え貼り付け]

フィルタで日曜日以外を抽出して可視セルをコピー
貼り付けたいセルを選択して [行列を入れ替え貼り付け]

マクロにするかどうかはお任せします。

この回答へのお礼

d-q-t-pさん

マクロの構文として「列の一部を削除して左に詰める」が知りたくて質問しました。
ありがとうございました。

お礼日時：2018/08/26 21:09

No.1 回答者： tom04 回答日時： 2018/08/24 23:41

こんばんは！

画像が小さいので詳細がよく判らないのですが、
おそらくB4・B5セルの数値を入れ替えると日付・曜日も変わるカレンダーになっているものだと思います。
そうだとすると、列削除してしまうと次の月には一からカレンダーを作り直さないといけなくなりますよね。
せっかくVBAで操作したいのであれば、一案です。
列削除ではなく、列の非表示にしてみてはどうでしょうか？
↓の画像のような配置になっているとします。

E5セル（セルの表示形式はユーザー定義から　d　としておきます）に
=IF(MONTH(DATE($B4,$B5,COLUMN(A1)))=$B5,DATE($B4,$B5,COLUMN(A1)),"")
という数式を入れます。

E6セルには
=TEXT(E5,"aaa")
という数式を入れています。

E5・E6セルを範囲指定　→　E6セルのフィルハンドルで右へ月末（31日まで）のAI列までフィル＆コピー！

これでB4・B5を入れ替えるだけでその月のカレンダーが作成できます。

そして↓のコードをシートモジュールにしてください。

Private Sub Worksheet_Change(ByVal Target As Range)
　If Intersect(Target, Range("B4:B5")) Is Nothing Then Exit Sub
　　ActiveSheet.Columns.Hidden = False
End Sub

Sub 非表示()
　Dim j As Long, c As Range, myRng As Range
　　For j = 5 To Cells(5, Columns.Count).End(xlToLeft).Column
　　　If Cells(5, j) <> "" Then
　　　　If WorksheetFunction.Weekday(Cells(5, j)) = 1 Then
　　　　　Set c = Cells(5, j)
　　　　End If
　　　　If Range("B5") = 1 Then
　　　　　If Day(Cells(5, j)) <= 3 Then
　　　　　　Set c = Cells(5, j)
　　　　　End If
　　　　End If
　　　　If Range("B5") = 12 Then
　　　　　If Day(Cells(5, j)) >= 29 Then
　　　　　　Set c = Cells(5, j)
　　　　　End If
　　　　End If
　　　　　If myRng Is Nothing Then
　　　　　　Set myRng = c
　　　　　Else
　　　　　　Set myRng = Union(myRng, c)
　　　　　End If
　　　End If
　　Next j
　　　myRng.EntireColumn.Hidden = True
End Sub

※　列の非表示の操作はご自身でマクロを実行する必要があります。
再表示の操作はB4・B5セルを入力した時点で行われます。m(_ _)m

この回答へのお礼

tom04さん

ご回答ありがとうございます。

＞おそらくB4・B5セルの数値を入れ替えると日付・曜日も変わるカレンダーになっているものだと思います。
はい、B4セルには「=DATE(B4,B5,1)」、B5セルには「=TEXT(E5,"aaa")」を入れています。

＞列削除ではなく、列の非表示にしてみてはどうでしょうか？
列そのものを削除するのではなく、元のシフト表を残したままコピーし、値で貼り付けた後、コピー後のシフト表の日曜日のみを削除して左に詰めたいのです。
理由はコピー後のシフト表を他のシートに１日ごとのタイムスケジュールを作成し、週ごとに印刷するためです。

＞再表示の操作はB4・B5セルを入力した時点で行われます。
やってみましたが、再表示されなかったので、シート全体を選択して再表示しました。

一案として参考にさせて頂きます。
ありがとうございました。

お礼日時：2018/08/26 21:08