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

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

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

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

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

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

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

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

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

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

この回答へのお礼

d-q-t-pさん

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

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

No.3 ベストアンサー 回答者： WindFaller 回答日時： 2018/08/25 17:08

まだ、No1の方の想定

　>おそらくB4・B5セルの数値を入れ替えると日付・曜日も変わるカレンダーになっているものだと思います。
にご質問者さんの確認が取れていませんので、私の解釈で進めてしまいました。

マクロで更新させてしまいますので、
E4 - 2018, E5 -月数を入れてください。
イベント・ドリブン型にするか、ボタン式にするのかどちらでもよいと思います。
その時に、別のシート(どこでもよいです）のセルに縦に、休日データを入れてください。

名前の登録で、「HOLIDAY」と付けてください。そして、呼び出せるようにしてください。

2018/8/11
2018/9/17
2018/9/24
2018/10/8
2018/11/3
2018/11/23
2018/12/23
2018/12/24
2018/12/29 ----------会社の年末・正月休み
2018/12/30
2018/12/31
2019/1/1
2019/1/2
2019/1/3 ----------会社の年末・正月休み(終了)
2019/1/14
2019/2/11
2019/3/21

質問の内容をみると、二段階で出来上がっているようです。
・表の更新と、
・日曜の列を飛ばしたデータの転載
(最初の「表の更新」は不要かもしれませんが、これがないと、2番めの表に転機は難しいかもしれません。）
なお、行末に「＊」がついているところは、位置を特定する部分ですから、位置が変わったら変更しなくてはなりません。色付けは、条件付き書式で行っています。

'標準モジュール
Sub DateLists()
''表の更新
Const ItemNO As Long = 10 'データの行数 *
Dim yr As Variant
Dim mn As Variant
Dim sDate As String
Dim fDate As Date
Dim oCol As Range
Dim cnt As Long, i As Long, j As Long
yr = Range("B4").Value '*
mn = Range("B5").Value '*
If MsgBox("シートを" & mn & "月に更新しますが、よろしいですか？", vbOKCancel) = vbCancel Then Exit Sub
sDate = yr & "/" & mn & "/" & 1
If IsDate(sDate) Then
　fDate = DateSerial(yr, mn, 1)
Else
　MsgBox "入力した日付が認識できません。", vbExclamation
End If
cnt = Day(DateSerial(yr, mn + 1, 0)) 'ひと月の日にち
Set oCol = Cells(5, Columns.Count).End(xlToLeft)
If oCol.Column > 3 Then
　Range("E5").Resize(2 + ItemNO, 31).ClearContents '決め打ち *
　Range("E19").Resize(2 + ItemNO, 31).ClearContents '決め打ち *
End If
With Range("E5").Resize(, cnt)
　.NumberFormatLocal = "d"
　.Offset(1).NumberFormatLocal = "aaa"
　.Resize(2).FormatConditions.Delete
　With .Resize(2).FormatConditions.Add(xlExpression, xlEqual, "=WEEKDAY(RC)=1")
　 With .Font
　　.Bold = True
　　.ColorIndex = 3
　 End With
　End With
　With .Resize(2).FormatConditions.Add(xlExpression, xlEqual, "=ISNUMBER(MATCH(RC,HOLIDAY,FALSE))=TRUE")
　 With .Font
　　.Bold = True
　　.ColorIndex = 45　'色(橙色)
　 End With
　End With
End With
Range("E5:E6").Value = fDate
Range("E5:E6").Offset(, 1).Resize(, cnt - 1).FormulaLocal = "= RC[-1] +1"
End Sub

Sub SecondMekeList()
''日曜の列を飛ばしたデータの転載
Dim yr As Long
Dim mn As Long
Dim sDate As String
Dim fDate As Date
Dim i As Long, j As Long
Dim cnt As Long
Const ItemNO As Long = 10 '2段目の項目数*

yr = Range("B4").Value '*
mn = Range("B5").Value '*
sDate = yr & "/" & mn & "/" & 1
fDate = DateSerial(yr, mn, 1)
cnt = Day(DateSerial(yr, mn + 1, 0))
Application.ScreenUpdating = False
For i = 1 To cnt
　With Range("E5").Offset(, i - 1)
　 If .DisplayFormat.Font.ColorIndex = 1 Then
　　'19行目から、日曜、祭日抜きで日付を入れる*
　　Cells(19, 5 + j).Resize(2 + ItemNO).Value = .Resize(2 + ItemNO).Value
　　j = j + 1
　 End If
　End With
Next
Application.ScreenUpdating = True
End Sub

添付画像で、位置関係を確認してほしいです。
2番めの表は、　「'19行目から、日曜、祭日抜きで日付を入れる」というところで、位置を調整します。10行ではないでしょうから、両方のマクロも、同じ数で、任意のメンバー数を入れてください。

この回答へのお礼

WindFallerさん

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

＞名前の登録で、「HOLIDAY」と付けてください。そして、呼び出せるようにしてください。
名前の登録はしましたが、呼び出せるようにとは具体的にどのような操作をするのでしょうか？

＞最初の「表の更新」は不要かもしれませんが、これがないと、2番めの表に転機は難しいかもしれません。
＞なお、行末に「＊」がついているところは、位置を特定する部分ですから、位置が変わったら変更しなくてはなりません。
すみません、この文章が理解できませんでした。

マクロを実行してみましたが、「DateLists」はデータが全て消えてしまいます。
データを元に戻して「SecondMekeList」を実行するとうまくできたのですが、E5：AI6セルの関数が消えてしまい、
B4・B5セルに年・月を入力しても日付と曜日が変わらなくなってしまいました。
できればE5：AI6セルの関数は上書きせずに残しておきたいです。


WindFallerさんのやり方で進めていきたいのですが、また教えて頂ければと思います。
よろしくお願いいたします。

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

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.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.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.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.8 回答者： WindFaller 回答日時： 2018/08/28 00:27

No.6 の回答者です。

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

曜日の行は、書式で出していますから、E6は、同じ数式でもよいし、=E5 として同じものを表示してもよいです。

>ここまでの操作で「SecondMekeList」のみを実行しましたが、まったく同じ表がコピーされただけでした。

選り分けてコピーする機能は、条件付き書式で、色が黒になっているという条件がないといけません。色分けで区別するのが簡単だと思ったからです。条件付き書式の設定は、マクロで行っていますが、手作業で入れていただいても、1度だけで済みます。

>私はこのフォーマットを作成したら他の者に引き継ぐつもりです。
そうなると、もう少し、手を加えたほうがよいかもしれません。

1年後ぐらいに休日・祭日データを更新してもらわないといけないとか、私自身、同じようなシートを使っていますが、あまり細かく説明すると、今は理解しにくいような気がします。ただ、ブック内でシートは月ごとに作っていくとなると、シートコピーをしたほうがよいのかなって思います。

この回答へのお礼

WindFallerさん

できました。

＞1年後ぐらいに休日・祭日データを更新してもらわないといけないとか、
確かにそこがひっかかるポイントでした。

でも同じシート内に日曜日と年末年始を非表示にした表を作成してくださり、とても助かりました。
ありがとうございました。

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

No.9 回答者： fujillin 回答日時： 2018/08/28 11:01

こんにちは

横からですが・・・

どうやら質問者様は仕組みを作成するだけで、実際に利用するのは他の方ということのようですが、VBAではなく関数を設定しておくという方法は選択肢にはないのでしょうか？
月によって実日数の増減はあるでしょうが、罫線は条件付き書式を利用することで可変にすることもできます。

関数利用の場合の長所は、元の表に入力すれば即時に反映される。（VBAを実行する必要がない）
VBAはブラックボックス化しそうなので、何かあるとまずお手上げになる。

欠点は、数式による計算なので、セルの位置関係が限定される。
（位置を変えたりしにくい。まぁ、VBAでも結果的には同様かもですが…）
また、間違って関数式を消したりしないように、関数式の入っているセルには保護をかけて運用するなどといったことが必要かも知れません。

この回答へのお礼

fujillinさん

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

＞VBAではなく関数を設定しておくという方法は選択肢にはないのでしょうか？
セルを削除して詰める作業が関数ではできないと思ったので質問させて頂きました。
もちろん私のやりたいことができるのであればVBAではなく関数でもかまいません。

＞関数式の入っているセルには保護をかけて運用するなどといったことが必要かも知れません。
他の同僚たち（パソコン初心者）が関数を上書きしてしまうことが何度もあり、「どうにかして欲しい」と頼まれたので他のエクセルファイルには保護をかけ、管理職にしかパスワードを知らせていません。

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

No.10 回答者： WindFaller 回答日時： 2018/08/29 11:13

No.9様のご意見を読みまして、あえてオフトピ(spin out)を許していただけるならですが。

これは、本スレとは直接関係がない内容ですが、次の私の書き込みに至る経緯としてみていただいてもよいです。

何度か、似たような場面に直面して、最終的には、ご質問者さんが、行けると思えるものなのか、どうかによって、マクロが生きるか死ぬかになってしまうものだと思います。

私が書いたものは、実は、きちんと使ってほしいと考えられて作ったものではなく、ご質問者さんが、どこまで分かって使えるか、という技量を試すような内容にできています。

それを、更に細かく作り込むべきかどうか、そういうところは様子見だったのです。
入念に作られたもの＝VBA エディタ画面をあけなくて済むような設計になれば、マクロ付きシートであるかどうかは、あまり大きな違いではなくなります。

問題は、最初は何からするか、ということが、正確には回答者側(私）には見えていないのです。私は、おそらく月の更新で、画面を新しくするところだと思ったのですが、そこらで、つまづきが出てしまうと、次のステップが踏めないのです。

元の表の雛形がある→それを新しいワークシートに、貼り付ける
または、元の表に直接書き込む

　月の更新→「前のデータを消す」→新しいデータ入力→休日抜きの2番目の表に転記→印刷か保存　．．．[最初に戻る]
という流れを想定していました。

でも、よく考えてみると、掲示板でこういう主張をして、9割の人は、そんなのんびりしたことをしていられるか、ということで、ボツになり、失敗しています。したがって、この後で、ダメ元でこちらが考えているものを修正して、見極めを付けてしまいます。

この回答へのお礼

WindFallerさん

＞きちんと使ってほしいと考えられて作ったものではなく、ご質問者さんが、どこまで分かって使えるか、という技量を試すような内容にできています。

私のレベルは「マクロの記録」や簡単なものをちょっと修正できる程度です。

＞月の更新→「前のデータを消す」→新しいデータ入力→休日抜きの2番目の表に転記→印刷か保存　．．．[最初に戻る]
という流れを想定していました。

「月の更新→「前のデータを消す」→新しいデータ入力→休日抜きの2番目の表に転記」までは想定されていた通りなのですが、日曜日と年末年始を含めない表を作成したかった理由は、この表を元に1日ごとのタイムスケジュール（誰がどの勤務に入っていて、午前と午後にどのような動きをするか）に落とし込むためです。

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