学校行事やアルバイトなどのシフト管理で時間帯ごとのシフト表を作る機会は多いかと思いますが、
忙しい中で用意しなければならないことが多く、なるべく手間をかけたくないところですよね。
けど、そんな中でやっぱり面倒だなと思うことは、
・毎回時間帯のスケジュール表をつくることは面倒
・参加する時間帯に色をつけたいがやり方がわからない
・ガントチャート形式のシフト表がほしいけどよいテンプレートがない
ということはありますよね。
今回は、そんな面倒なことを解消する、
時間帯ごとのガントチャート付きシフト表を瞬時に作成する方法をご紹介します！
もくじ
ガントチャート付きシフト表の完成イメージ
ガントチャート付きシフト表の完成イメージは以下の通り、出勤時間帯に色が入り、さらに遅番早番などの勤務種別の文字が自動的に入るようになっています。
さらに時間帯列の初めのセルの時間を変えると、自動的に時間帯は変更され、色、勤務種別も再計算されます。
▼
別のシフト表をつくる場合、タイトルや時間帯の変更だけで済むという訳で、
シフト表作成の手間がずいぶん省けますね！
では、作り方について説明をします。
ガントチャート付きシフト表の作成手順
まずは、以下のようにメンバーと出勤・退勤時間、勤務種の表を用意します。
①時間帯列を作成する
まずは時間帯列を作成しましょう。
今回は、時間帯列のはじめのセルだけを変えたら他のセルも自動的に時間帯が入力されるようにします。
時間帯は1日ですので、最大0:00～23：00となりますが、
利用状況に応じてアレンジしていただければと思います。
今回のサンプルは午前6：00を指定しますので、F2セルに6：00を入力します。
セルの書式設定は、「時刻」＞「13：30」を指定します。
続いて隣のセルの値ですが、自動掲載をさせたいので、
を入力します。
これはF2セルの値に1時間を加算するという意味となります。
次に「7：00」が入力されたセルを時間帯終了列の位置までドラッグします。
はい、これで時間帯列の作成は完了です。
②ガントチャートを作成する
続いて、今回のメインとなるガントチャートが表示されるよう作り込んでいきましょう。
1番目のメンバで、時間帯のはじめとなるF3のセルを選択し、以下を入力します。
入力が完了すると、以下のようになります。
変わらない方は出勤時間、退勤時間が正確に入力されているか、セルの指定が間違っていないか確認してください。
次に関数を入力したセルを時間帯最後尾列までドラッグします。
続いて、最後のメンバの行までドラックします。
はい、勤務種の文字だけですが、ガントチャートっぽくなりましたね。
③ガントチャートに色を入れる
続いてガントチャートをより見やすくするためにセルや文字に色を付けていきましょう。
1番目のメンバで、時間帯のはじめとなるF3のセルを選択し、
リボンメニューの「条件付き書式」をクリックし、「新しいルール」をクリックします。
ウインドウが表示されたら、「指定の値を含むセルだけを書式設定」を選択し、
ルールの内容のところに「セルの値」、「次の値に等しい」を選択、「早番」と入力します。
次に、セルの色、文字の色を「書式」から指定し、「OK」をクリックします。
「適用先」の範囲を拡張し、時間帯の最後尾列、メンバの最終行の範囲を指定します。
入力が終わったら、「OK」をクリックします。
はい、早番のセルの色が変わりましたね。
次に同じ要領で遅番のセルも色を付けていきます。
1番目のメンバで、時間帯のはじめとなるF3のセルを選択し、
リボンメニューの「条件付き書式」をクリックし、「新しいルール」をクリックします。
ルールの内容のところに「セルの値」、「次の値に等しい」を選択、「遅番」と入力します。
次に、セルの色、文字の色を「書式」から指定し、「OK」をクリックします。
以下を「適用先」へ入力し、ルールの範囲を拡張します。
終わったら「OK」をクリックします。
はい！ガントチャートができ上りましたね！
③時間帯別の必要人数を計算する
続いて、時間帯別に必要な人数と出勤人数、過不足人数を算出するように計算式を追加します。
時間帯別の必要人数の行を追加し、任意の人数を入れていきます。
続いて、出勤人数を自動算出するようにします。
勤務種の早番、遅番となっていれば数字をカウントしたいので、
F9のセルに以下を入力し、
時間帯の最後尾列までドラッグしていきます。
続いて、過不足人数を自動計算させます。
F10セルに以下を入力し、
時間帯の最後尾列までドラッグしていきます。
この時点で、過不足人数が自動計算されていることがわかるかと思います。
次に、「-1」以下となっている不足しているセルをもっと目立たせるように赤く塗りつぶしていきます。
リボンメニューの「条件付き書式」をクリックし、「新しいルール」をクリックします。
ルールの内容のところに「セルの値」、「次の値より小さい」を選択、「0」と入力します。
次に、赤っぽいセルの色、文字の色を「書式」から指定し、「OK」をクリックします。
以下を「適用先」へ入力しルールの範囲を拡張します。
完了したら「OK」をクリックします。
はい！「-1」となっているセルが赤色に変更されましたね！
ガントチャート付きシフト表へ休憩時間を追加する
シフト表へ出退勤の時間のほかに休憩時間を追加します。
こちらが完成イメージです。
①休憩時間を入力する列を作成する
休憩時間の「開始時間」と「終了時間」、そして「休憩時間」とタグの「Pos」の列を作成します。
②休憩時間の計算式を挿入する
休憩時間の計算式を挿入します。
H3セルの場合は以下の計算式となります。
最下部までドラッグします。
③タグを挿入する
休憩であるとわかるようにタグを挿入します。
サンプルでは「休憩」とし、最下部まで入力します。
④ガントチャート部の計算式を変更する
ガントチャート部へ挿入されている既存の計算式を変更します。
J3列を選択し以下の計算式を入力します。
次に最下位の行までドラッグし、最終列までドラッグします。
④「休憩」がガントチャートへ表示されるか確認する
「休憩」がガントチャートへ表示されるか確認しましょう。
はい、表示されますね。
さいごに
いかがでしょうか？
今回は、
時間帯ごとのガントチャート付きシフト表を瞬時に作成する方法について
まとめました！
よく利用するエクセルのシフト表。
ガントチャートもマスターしてより使い分けしたいですね！
また、質問させていただきます ご迷惑ならごめんなさい
今度は、シフト表に取り掛かっています
ある程度の下地は あるのですが すごく重たくなりどうしたものかと思い
コメントさせていただきました
時間を入力して ガンチャートを作成するのではなく ガンチャートから時間を
吐き出すようにしております
エクセルの一つのマスを１５分としております
朝９：００～１７：００までを勤務とした場合 ９時のセルから１７：００のセルまで■を埋めていきます 最後のセルに 勤務時間が ８時間とカウントされます
そのあとに 休憩時間の取得です セルの■を消すとそこから休憩時間が始まり
空白の部分が休憩始まりと終わりです
始業 終業 休憩1 終了1 休憩2 終了2 休憩3 終了3 休憩4 終了4
9:00 18:00 10:00 11:00 15:00 15:30 0:00 0:00 0:00 0:00
となるようにしています
式は複雑で別シートに結果を吐き出し また戻すという方法です
F6から■を埋めるとして
別シートに１５分単位で以下の式を入れてます
E7に
IF(AND(shift!$F$6=””,OR(COUNTIF(shift!$G$6,”■”),COUNTIF(shift!$G$6,”★”))),INDEX($D$1:$BP$1,0,(COLUMN(shift!$G$6)-5)),0)
E8に
IF(AND(OR(COUNTIF(shift!$G$6,”■”),COUNTIF(shift!$G$6,”★”)),shift!$H$6=””),INDEX($D$1:$BP$1,0,(COLUMN(shift!$G$6)-4)),0)
ざっとBQの列まで埋めていますそのあと
COUNTIF(BS7:CB7,”>0″)
LARGE($E7:$BQ8,9)
LARGE($E7:$BQ8,8)
と続けます
シフト表に戻り
始業 終業 休憩1 終了1 休憩2 終了2 休憩3 終了3 休憩4 終了4
9:00 18:00 10:00 11:00 15:00 15:30 0:00 0:00 0:00 0:00
時間を入れるため
IF(data!BR7=0,0,LARGE(data!$BS7:$CB7,data!BR7))
などと複雑になっています
一つのバーチャートの値をとるのに
２行と６0列ぐらい使います 一人に対してですから もう途方もない作業となってます 簡素にできないかと思うのですが
始業 終業 休憩1 終了1 休憩2 終了2 休憩3 終了3 休憩4 終了4
9:00 18:00 10:00 11:00 15:00 15:30 0:00 0:00 0:00 0:00
の時間を取得できないかと 複雑すぎて説明ができなくなりました
すいません
非常にややこしいので 仕様を変えました
セルA1から
始業 終業 休憩1 復帰1 休憩2 復帰2 休憩3 復帰3 休憩4 復帰4
9:00 18:00 10:00 10:15 11:00 11:15 12:00 12:15 14:00 14:15
と ４回の休憩を取ります 全体のチャートは表示できるのですが
休憩時間を空白で 表示したいのですがセルは１５分間隔です
セルのE5から色付けしたいのですが 色または ■ ☆などのマークで入れたいのですが いつもむつかしいことを質問してすみません
休憩の時間を空白にしたいのですが
いつもご利用ありがとうございます。
ご質問の内容を整理致しますと、
①始業、終業、休憩時間（4つ）をガンチャートの情報から取得したい。
②現在関数で取得しているが動作が重たいので改善したい。
③ガンチャートは”■”や”☆”の記号で表現したい。
でしょうか。
①に関しては関数で対応できているようですので、問題なしとします。
②に関しては関数の条件式を減らすことをしない限り改善が難しいかと思われます。
③に関しては表記を加えるだけで良いかとおもいますが、条件式を加えるので②に影響することとなります。
そこでご提案ですが、VBAを利用して①を実現、②を解消する方法はいかがでしょうか。
随時実行させる手間はあるものの軽量化と動作の改善は可能かと思います。
以下VBAのサンプルとなります。
◇サンプルシート
セルA1から
名前 9:00 10:00 11:00 12:00 13:00 14:00 15:00 16:00 17:00 始業 終業 休憩1 復帰1 休憩2 復帰1 休憩3 復帰3 休憩4 復帰4
を入力。
A2からJ4セルへ以下を入力
Aさん ■ ■ □ ■ □ □ ■
Bさん ■ □ ■ □ ■ ■ □ □ ■
Cさん ■ □ ■ □ ■ □ ■ □ ■
※休憩は空欄だと始業取得に影響あり空欄ではなく□としています。
◇サンプルVBA
Sub シフト表から時間集計()
Dim tempHairetsu As Variant
Dim tempHairetsu1D As Variant
Dim dateStartTime As Date
‘基準時間指定
dateStartTime = Range(“B1”)
dateStartTime = DateAdd(“h”, -1, dateStartTime)
k = 0
‘ガントチャート情報を配列に格納
tempHairetsu = Range(“B2:J4”)
‘時間をクリア
Range(“L2:U4”).Clear
Debug.Print UBound(tempHairetsu)
‘人数分繰り返す
For i = 1 To UBound(tempHairetsu)
‘tempHairetsu = Range(“B” & i + 1 & “:J” & i + 1)
‘二次元配列を1次元に変換
tempHairetsu1D = WorksheetFunction.Index(tempHairetsu, i)
‘はじめの■の位置番号を取得
numKaishi = Application.Match(“■”, tempHairetsu1D, 0)
‘始業時間算出
Cells(i + 1, 12) = DateAdd(“h”, numKaishi, dateStartTime)
For j = 1 To UBound(tempHairetsu1D)
‘勤務”■”の位置取得
If tempHairetsu1D(j) = “■” Then
‘終業時間算出
Cells(i + 1, 13) = DateAdd(“h”, j + 1, dateStartTime)
End If
‘休憩”□”の位置取得
If tempHairetsu1D(j) = “□” Then
If Not tempHairetsu1D(j – 1) = “□” Then
‘休憩時間算出
Cells(i + 1, 14 + k) = DateAdd(“h”, j, dateStartTime)
End If
If Not tempHairetsu1D(j + 1) = “□” Then
‘復帰時間算出
Cells(i + 1, 14 + k + 1) = DateAdd(“h”, j + 1, dateStartTime)
k = k + 2
End If
End If
Next
k = 0
Next
End Sub
◇結果
始業 終業 休憩1 復帰1 休憩2 復帰1 休憩3 復帰3 休憩4 復帰4
10:00 18:00 12:00 13:00 14:00 16:00
9:00 18:00 10:00 11:00 12:00 13:00 15:00 17:00
9:00 18:00 10:00 11:00 12:00 13:00 14:00 15:00 16:00 17:00
※2行目からAさん、Bさん、Cさん分の結果となります。
ご検討宜しくお願い致します。
なるほどですね、やはり計算式ではかなり複雑で無理がありますね
検証いたします
いま取り組んでいるものが、ひと月の勤務表から 日毎に勤務時間を取り出し
日毎バーチャートを表示し その値をｃｓｖ化してウェブの勤務表にUＰ
ＵＰロードするというのを作成中です
通常なら、そう難しいことではないのですが、
年中無休 勤務シフトバラバラ、休憩バラバラ １５分を４回であったり
３０分を二回であったりと なので苦労しております
そこでこのようになっています
シート１ 月３０日分
一人の社員で７行使います
１行目 社員ID
２行目 各シフト 例えばシフトAとか
３行目 勤務総時間
４行目 休憩１
５行目 休憩２
６行目 休憩３
７行目 休憩４ としています
１日が C列としますと ２行目のシフトをプルダウンで 選び
３，４，５，６，７とIFERROR(VLOOKUP(C10,基本シフト,3,0),””)で取得しています
３，４，５，６，７はそれぞれ
IF(H3=0,””,TEXT(H3,”[h]:mm”) &”,”&TEXT(I3,”[h]:mm”))でつなぎ
９：００，１８：００で表示させてます
時間帯だけ全部繋げて一つもセルに表示したいのですが 時間ごとに改行とかできれば 一つのセルに収まるのですが 良い方法はありませんか
また最初の総勤務時間だけフォントの大きさを違えるとか。。
先は長いですまた度々お世話になります
時間ごとに改行し、一つのセルに表示させる方法については
「９：００，１８：００」を
「９：００
１８：００」
にするということでしたら、
対象セルの書式を「折り返して全体を表示する」に設定した上、
TEXT(H3,”[h]:mm”) &”,”&TEXT(I3,”[h]:mm”)
を
TEXT(H3,”[h]:mm”) &CHAR(10)&TEXT(I3,”[h]:mm”)
に変更することでできます。
よろしくお願いいたします。
その方法しかないですかやはり ありがとうございます
また、問題が出てきました CSV出力時に 各時間を
9:00,17:00,11:30,12:00,15:00,15:30 のようにつなげて一つのセルに収めています
=TEXTJOIN(“,”,,TEXT(L12:S12,”h:mm;;”)) この関数を使いました
問題はないかと思うのですが これは新しい関数で バージョンが古いと
できないとか。。
ほかに方法はないかと探っています
=MID(J2:S2,1,999) なものでどうかと試しましたが うまくつながりません
時間が ０．７５ とかになります セルの書式でもダメでした
また空白行もあるため うまくいかない
J3&”,”&B2&”,”&K3&”,”&L3&”,”&M3&”,”&N3&”,”&O3&”,”&P3&”,”&Q3&R3
な感じで試してみましたが 時間が ０．７５とか０．１５とかで
表示される 空白行が ,,,,,, で残る さてさていかがしたものですか
最悪 定義付けですかね
なるべくBVAは使いたくないのですが 重くなるので
Function TEXTJOIN(Delim, Ignore As Boolean, ParamArray par())
Dim i As Integer
Dim tR As Range
TEXTJOIN = “”
For i = LBound(par) To UBound(par)
If TypeName(par(i)) = “Range” Then
For Each tR In par(i)
If tR.Value “” Or Ignore = False Then
TEXTJOIN = TEXTJOIN & Delim & tR.Value2
End If
Next
Else
If par(i) “” Or Ignore = False Then
TEXTJOIN = TEXTJOIN & Delim & par(i)
End If
End If
Next
TEXTJOIN = Mid(TEXTJOIN, Len(Delim) + 1)
End Function
TEXTJOIN関数はExcel2016以降で追加された関数のようですね。
業務でご利用されるバージョンの確認と念のためユーザテストをしたほうがよいでしょう。
代案としては以下のような感じでしょうか。
=TEXT(L3,”h:mm;;”)&”,”&TEXT(M3,”h:mm;;”)&”,”&TEXT(N3,”h:mm;;”)
時間がシリアル値表示されているようですので、時間の表示形式に変換しています。
休憩時間を入れる場合どうすればいいのでしょうか、、、
いつもご利用ありがとうございます。
休憩時間については追加可能です。
ただし変更する箇所が多く、テキストのみですと説明が難しいので
本記事に画像付きで実装手順を追記させていただきました。
詳細については
本記事
https://extan.jp/?p=3011
の
「ガントチャート付きシフト表へ休憩時間を追加する」
をご参照頂きたくお願いいたします。
ほぼ完成と思いきや 致命的なことがありました
シフト複数あり それぞれに 始業 終業 休憩１ 復帰１ 休憩２ 復帰３
シフトA 9:00 18:00 12:00 13:00 15:00 15:15
このようなパターンを基本としマスターとして 別シートの時間範囲に入れてあります１０パターン程
セルA1に入力規則で リストを表示しそこに シフトAと入るようにして
A2 A3 A4にVlookup関数を使いそれぞれの時間が入るようにしております
=IFERROR(VLOOKUP(A1,時間,13,0),””)
うまく取得してくれて それぞれの値が 各セルに代入されました
が 問題ありました マスターの数字を触ると すべての数字が変わりました
あらー A2が 9:00 したら マスターを10:0０にするとすべて変わる
考えてみれば当然ですね かといって パターンを増やすのも選択が大変
入力された値を 手動入力すると 式が消える
で考え付いたのが VBAでフォームを作り リストを表示 その値をセルに代入
編集可能にしました
該当セルのクリックでフォームを表示 フォームのコード
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
‘ダブルでマクロ
If Not Application.Intersect(Target, Range(“A１:A21”)) Is Nothing Then
Cancel = True
UserForm1.Show
End If
End Sub
フォームのコード
Private Sub UserForm_Initialize()
Dim lastRow As Long
lastRow = Sheets(“設定”).Cells(Rows.Count, 1).End(xlUp).Row
With ListBox1
.ColumnHeads = True
.ColumnCount = 10
.ColumnWidths = “40;50;50;50;50;50;50;50”
.RowSource = “設定!” & Range(“I2”, “S50” & lastRow).Address
End With
リストが表示されました 問題はここから それぞれの値をセルに代入するため
フォームコードに
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveCell = ListBox1.List(ListBox1.ListIndex, 0)
End Sub
を記入 A1に 選択の値が入ります OK
A２からは何も入らないこの場合
A１に シフトA
A2に ９：００
A3に １８：００
A4に １２：００ と以下順番にリストの値を入れたいのですが
ActiveCell.Offset(1).Select を書いてみたのですが ずれるだけ
代入が完了したら フォームを自動で閉じたいのですが
どうもこの辺が 苦手です よろしくお願いいたします
リストボックスからActiveCellへの代入する件ですが、
ActiveCellとOffsetを使って選択セル以下へ代入するということでしたら
ActiveCell = ListBox1.List(ListBox1.ListIndex, 0)
ActiveCell.Offset(1).Activate
ActiveCell = ListBox1.List(ListBox1.ListIndex, 1)
ActiveCell.Offset(1).Activate
ActiveCell = ListBox1.List(ListBox1.ListIndex, 2)
・・・
という形となります。
代入完了後ユーザフォームを閉じる方法は
Unload UserForm1
を代入処理の最後に入れてください。
よろしくお願いいたします。
ありがとうございます 完璧です
色々調べているのですが リストボックスを表示したときに空白行の処理をしたいのですが よくわかりません
Private Sub UserForm_Initialize()
Dim lastRow As Long
lastRow = Sheets(“設定”).Cells(Rows.Count, 3).End(xlUp).Row
With ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = “80;60;60;60;60;60;10;10”
.RowSource = “設定!” & Range(“T3:Z30”).Address
End With
End Sub
のように書きましたが 設定の範囲のところに 式はありますが
空白になる行があり
そのあとにまた 値があります ユーザーフォームを開いたときに空白行になります いかに処理したらよろしいでしょうか
T3の行は 値あり
T5～T10まで 空白
T10～また 値あり です
またユーザーフォームを
UserForm1.Show vbModeless
モードで開いた時の セルの入力範囲の規制をしたいのですが
例えば A1～A20,C1～C30 の範囲は入力できるが ほかのセルには入力できないとか よろしければ ご教授ください
いつもすみません
リストボックスの空白行非表示の件ですが、
Range(“T3:Z30”)を配列に格納して、すべての列が空白である行を除外する処理をすればよいかと思われます。
.RowSource = “設定!” & Range(“T3:Z30”).Address
をコメントアウトし以下へ変更します。
‘空白行削除処理
temp = Sheets(“設定”).Range(“T3:Z30”)
Dim arr() As Variant
ReDim arr(1 To UBound(temp, 1), 1 To UBound(temp, 2))
c = 0
d = 1
For a = LBound(temp, 1) To UBound(temp, 1)
For b = LBound(temp, 2) To UBound(temp, 2)
If temp(a, b) = “” Then
c = c + 1
End If
Next
If c < UBound(temp, 2) Then For e = LBound(temp, 2) To UBound(temp, 2) arr(d, e) = temp(a, e) Next d = d + 1 End If c = 0 Next .List = arr VBAだと少々複雑になるので、Excelシート側で空欄を除くフィルターなどかけるとよいかもしれません。 セルへの入力制限についてはExcelの標準機能の「シートの保護」で実現できるかと存じます。 よろしくお願いいたします。
If c < UBound(temp, 2) Then For e = LBound(temp, 2) To UBound(temp, 2) arr(d, e) = temp(a, e) Next d = d + 1 End If c = 0 Next .List = arr
の行でしょうか？ エラーが出ます
すみません
エラーについてですが、どのような内容（エラーコード、メッセージ等）であるか教えて頂けますでしょうか。
また、
’.RowSource = “設定!” & Range(“T3:Z30”).Address
は無効化しているか、
End With
より上部に記載されているかもご確認頂けますでしょうか。
コンパイルエラー ステートメントの最後 arr が候補になってます
無効かして End With より上です
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim lastRow As Long
‘ListBox1.Clear
lastRow = Sheets(“設定”).Cells(Rows.Count, 3).End(xlUp).Row
With ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = “80;60;60;60;60;60;10;10”
‘.RowSource = “設定!” & Range(“T3:Z30”).Address コメントアウト
If c < UBound(temp, 2) Then For e = LBound(temp, 2) To UBound(temp, 2) arr(d, e) = temp(a, e)
Next d = d + 1 End If c = 0 Next .List = arr
End With
Application.ScreenUpdating = True
End Sub
承知いたしました。
以下に差し替えご確認頂けますでしょうか。
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim lastRow As Long
‘ListBox1.Clear
lastRow = Sheets(“設定”).Cells(Rows.Count, 3).End(xlUp).Row
With ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = “80;60;60;60;60;60;10;10”
‘.RowSource = “設定!” & Range(“T3:Z30”).Address コメントアウト
‘空白行削除処理
temp = Sheets(“設定”).Range(“T3:Z30”)
Dim arr() As Variant
ReDim arr(1 To UBound(temp, 1), 1 To UBound(temp, 2))
c = 0
d = 1
For a = LBound(temp, 1) To UBound(temp, 1)
For b = LBound(temp, 2) To UBound(temp, 2)
If temp(a, b) = “” Then
c = c + 1
End If
Next
If c < UBound(temp, 2) Then For e = LBound(temp, 2) To UBound(temp, 2) arr(d, e) = Format(temp(a, e), "hh:nn") Next d = d + 1 End If c = 0 Next .List = arr End With Application.ScreenUpdating = True End Sub
ありがとうございます ばっちりです
少しパフォーマンスもあがったような気がします
パフォーマンスで気になるところがあるのですが
A列に ★★★★のマークがある場合 その行を非表示にする
Sub 休4()
Application.ScreenUpdating = False
Static ChkNext As Boolean
If ChkNext = False Then
ChkNext = True
‘MsgBox “１回目の押下です。”
‘ここに１回目の実行コードを記述
Dim rw As Long ‘// 行カウンタ
For rw = 10 To Range(“A200”).End(xlUp).Row
If Range(“A” & rw).Value = “★★★★” Then
Rows(rw).Hidden = True
End If
Next
Else
ChkNext = False
Call 復4
End If
Application.ScreenUpdating = True
End Sub
と書いています 少しもっさりするのですが 改善方法はありますか？
しかしいつもながら 勉強させていただいて感謝しております
どのような文献を読んで勉強されているのか 差し支えなければご教授ください
私も、もうすぐ定年なので ボケ防止でさらに勉強したいです
動作改善の件ですが、
For rw = 10 To Range(“A200”).End(xlUp).Row
If Range(“A” & rw).Value = “★★★★” Then
Rows(rw).Hidden = True
End If
Next
を
temp = Range(“A10:A200”)
For rw = 1 To UBound(temp)
If StrComp(temp(rw, 1), “★★★★”) = 0 Then
Rows(rw + 9).Hidden = True
End If
Next
に変えていかがでしょうか。
※こちらの環境ですともっさりしなかったのであまり差は感じませんでした…
また、VBAの勉強法ですが、体系的に学んだというわけではなく、
業務上必要になったので調べ、作り、覚えてきたという感じです。
ただ、その中でよかった学習法は動画教材で、よく通勤中に視たり、聴いたりしていました。
すこしお金がかかってしまいますが、Udemyの研修は何回も受講できるのでよかったです。（企業向けもあるようです）
Excel VBAに関する良書はたくさんありますので、別の記事にでもまとめたいとおもいます。
よろしくお願いいたします。
ありがとうございます そうですね 体感的にはあまり変わらないような気がします
お手数かけました
毎日あちこちの文献をあさりながら 勉強をしているのですが、それぞれ同じ動作をするのに表現方法が違うのでどれが正解なのかさっぱりわかりません
基礎がないとだめなのですかね
さて 私のシフト管理も 最終CSVまで吐き出せるようになりました
勤務体系が 非常に複雑なので大変な作業です
また、それぞれ使う環境で動いたり動かなかったりで 時間の浪費が激しいです
シフトにしても５０形態ぐらいあるので、あたま痛いです
これから、WEBのシステムにUPすることを考えてますが 少し断念
頭が回りませんここで少し
質問させてください
=TEXTJOIN(“,”,,TEXT(L12:S12,”h:mm;;”))の関数が新しく旧バージョンであまりよろしくないので以下のようにしましたご確認お願いいたします
内容は ５つのセルの内容を コンマでつないで一つのセルに入れているのですが
通常でつなぐと 空白のせるがどうしても コンマ が残ってしまい
UP
UPしたときに認識できないので コンマを消す作業です 長いです
+IF(シフト!C11=””,””,シフト!C11)&IF(AND(シフト!C11″”,シフト!C12″”),”,”,””)&IF(シフト!C12=””,””,シフト!C12)&IF(AND(シフト!C11&シフト!C12″”,シフト!C13″”),”,”,””)&IF(シフト!C13=””,””,シフト!C13)&IF(AND(シフト!C11&シフト!C12&L3″”,シフト!C14″”),”,”,””)&IF(シフト!C14=””,””,シフト!C14)&IF(AND(シフト!C11&シフト!C12&シフト!C13&シフト!C14″”,シフト!C15″”),”,”,””)&IF(シフト!C15=””,””,シフト!C15)
ご質問の内容を確認させて頂きたく、
空白のセルにコンマ「,」が残るので削除する
という部分ですが、以下の認識でよろしいでしょうか。
値A+空白+値B+値C+値D
↓ コンマ「,」で結合
値A,,値B,値C,値D
となり、その中の
「,,」を「,」
に変更する。
サンプルデータがあればありがたいです。
よろしくお願いいたします。
説明不足ですみません
まず、画面が挿入できれば良いのですが 文章で説明いたします
例
今作りこみ中の分で説明いたします
シートは今のところ４シートです
１，シフト（月） ２，時間帯（ガンチャート、日） ３，設定 ４，ｃｓｖ
この中の時間帯を ＣＳＶにすというところです
設定で
J３～S3 まで
始業、終業、休１，復１、休２、復２、休３、復３、休４、復４
とあります
ガンチャート作成のためそれぞれの値を入れるようにしてます これが基本設定です
シフト画面に入れるため それぞれSETで
U3～Y3まで それぞれ
=IF(J3=””, “”, TEXT(J3,”[h]:mm”) &”,”&TEXT(K3,”[h]:mm”))
でつないで 9:00,16,00 始業と終業を U3に入れるようにしてます
順に 始業終業、休復１、休復２，休復３，休復４ となってます
上記関数の場合 &”,”& でコンマでつないでます J3が空白なら計算しない
これは、自分的には 正解かと思います
次にこのつないだ時間帯を シフト表に入れるのですが
ユーザーフォームでこの値を取り 入れていきます
社員一名の シフト ６行です
C10から下へ
シフト名
勤務 C10 9:00.16:00 ここが休日、有給などの時もある
休１ C11 11:00,12:00
休２ C12 空白
休３ C13 空白
休４ C14 空白
あとはこの五つのセルの値を 結合して CSV シートの 一つのセルに入れる
ここから 問題部分です
すでにテキスト変換されているので ”[h]:mm” の部分は 必要ない？
=IF(J10=””, “”, TEXTJOIN(“,”,,TEXT(C10:C14,”h:mm;;”)))
問題なし
9:00,16:00,11:00,12:00
しかしバージョン古いと使えない
最初の関数で
=+IF(C10=””, “”, C10&”,”&C14) でつなぐ
9:00,16:00,11:00,12:00,,,
空白があるために 最後に「 ,,, 」 コンマがの残ってしまう
この最後のコンマの処理です
C10～C14のいづれか一つでも空白があれば その空白を飛ばし
次のセルの値をつなぐ この辺りは CSV で出力する際にBVAでもよかなと思うのですが 処理がわかりません
試しに
Sub 文字結合2()
Dim 結合文字 As String
Dim 範囲 As Range
結合文字 = “”
For Each 範囲 In Range(“C１０:C14”)
結合文字 = 結合文字 & 範囲.Text & “,”
Next 範囲
Range(“B15”).Value = 結合文字
End Sub
としてみましたが 空白で「,,, 」 が残りました
ご連絡ありがとうございます。
「,,, 」の処理ですが、SUBSTITUTE関数で置換する方法でいかがでしょうか。
=SUBSTITUTE(C10&”,”&C11&”,”&C12&”,”&C13&”,”&C14,”,,,”,”,”)
「,,, 」のほかに「,, 」も置換対象とする場合は以下のように入れ子にします。
=SUBSTITUTE(SUBSTITUTE(C10&”,”&C11&”,”&C12&”,”&C13&”,”&C14,”,,,”,”,”),”,,”,”,”)
ただし、以下のパターンの場合はCSVの構成が変わってしまいますのでご注意ください。
休１ C11 空白
休２ C12 空白
休３ C13 空白
休４ C14 値あり
休１ C11 値あり
休２ C12 空白
休３ C13 空白
休４ C14 値あり
よろしくお願いいたします。
早速ありがとうございます
=SUBSTITUTE(SUBSTITUTE(シフト!C11&”,”&シフト!C12&”,”&シフト!C13&”,”&シフト!C14&”,”&シフト!C15,”,,,”,””),”,,”,””)
で記入してみました
結果
C１０ に値があり他空白の場合
9:30,17:00, 最後に コンマが残り ｃｓｖ NGでした
２個の場合OK
３個の場合OK
４個の場合NG
５個の場合OK という結果でした どうしても最後にコンマが残るパターンが
出現します 「 , ] コンマ一つを置換対象に入れてしまうと
今度はつながりがおかしくなります
どうしたらよいのか
このような考えはいかがでしょう
&”,”&の部分をそれぞれ違うパターンでつないでおいて出てきたパターンを置換していく 何やら混乱してきました
最後にコンマが残るパターンの対応ですが、
最終文字列が「,」である場合に削除する処理を加えるやり方でいかがでしょうか。
=IF(RIGHT(B15,1)=”,”,REPLACE(B15,LEN(B15),1,””),B15)
SUBSTITUTE関数結果を“B15”に表示させ、別のセルに上記計算式を入れてください。
＞&”,”&の部分をそれぞれ違うパターンでつないでおいて出てきたパターンを置換
こちらのやり方も有効かと思われます。
たとえば、C列のセルが空欄である場合に明示的に判断できる記号を表示させ、それを除外するというやり方です。
以下サンプルです。
D列に ※D10入力前提です。D14までドラッグしてコピーしてください。
= IF(C10 = “”, “値なし”,C10) ※空欄の場合”値なし”と表示されます。
計算列に
=SUBSTITUTE(D10&”,”&D11&”,”&D12&”,”&D13&”,”&D14,”,値なし”,””) ※”,値なし”を除外します。
を入れます。
ご検討の程お願いいたします。
=IF(RIGHT(B15,1)=”,”,REPLACE(B15,LEN(B15),1,””),B15)
SUBSTITUTE関数結果を“B15”
この方法がべすとのような気がいたします シートを二枚使用すればCSVに
無事に吐き出せそうですね 一行で書くのは難ありですね
根気よくやりたいと思います
ご指導のおかげで 何とか完成まで近づきました ありがとうございます
あと一つ、こんな風にできたらよいなと思うのですが 少しググっていたら見かけたのですが
「ひと月単位で作成して 作成したものを 同じブックの別シートに必要な行だけ取り出し シート名を 特定のセルの値に対して追加する」
作成中のものは ひと月２０人分 一人分が６行です ひと月分で１２０行使います
１２か月分作ると１５００行ぐらい使います ですので ひと月分を
月を変えると日付、曜日が連動するように作っています
一人分が６行のため 丸ごとシートコピーするのではなく必要な行だけ
取り出したいのです
A7に 2021年７月 とあります 追加のシートの名前は A7の値
取り出したい行は A８行目の日付 A９行目の曜日
A１０行目の名前とシフトの場所 あと各STAFFの同じ行です
次のスタッフは A１６行目 と飛び飛びです
月途中でも 保存でき、同じシート名の場合上書きする
Sub 新規シート保存()
Dim データ範囲 As Range
Dim 抽出列 As Variant
Dim i As Long
Set データ範囲 = ActiveSheet.Range(“A8:AG130”).CurrentRegion
抽出列 = Array(1, 3)
Sheets.Add.Name = “Range（A１）”
For i = 0 To UBound(抽出列)
データ範囲.Columns(抽出列(i)).Copy Sheets(“抽出”).Range(“A1”).Offset(0, i)
Next i
End Sub
何かわけのわからないこと書いてます すみません
形になってきたようでよかったです。
追加のご質問
「ひと月単位で作成して 作成したものを 同じブックの別シートに必要な行だけ取り出し シート名を 特定のセルの値に対して追加する」
ですが、いただいたVBAに少し追加、変更をいたしましたのでご確認の程お願いいたします。
Sheets.Add.Name = “Range（A１）”
→objWs.Name = Sheets(“＜シート名を記載＞”).Range(“A7”)
“A7″へ変更しました。
データ範囲.Columns(抽出列(i)).Copy Sheets(“抽出”).Range(“A1”).Offset(0, i)
→データ範囲.Columns(抽出列(i)).Copy objWs.Range(“A1”).Offset(0, i)
追加したシートへ追記するようにしました。
抽出列や範囲は適宜調整頂ければと存じます。
Sub 新規シート保存()
Dim データ範囲 As Range
Dim 抽出列 As Variant
Dim i As Long
Set データ範囲 = Sheets(“＜シート名を記載＞”).Range(“A8:AG130”).CurrentRegion
抽出列 = Array(1, 3)
Dim objWs As Worksheet
Set objWs = Sheets.Add
objWs.Name = Sheets(“＜シート名を記載＞”).Range(“A7”)
For i = 0 To UBound(抽出列)
データ範囲.Columns(抽出列(i)).Copy objWs.Range(“A1”).Offset(0, i)
Next i
End Sub
みません 私勘違いをしておりまして 行の抽出でした そこで下記のように書き直してみました
Sub 新規シート保存()
Dim データ範囲 As Range
Dim 抽出行 As Variant
Dim i As Long
Set データ範囲 = Sheets(“シフト”).Range(“A8:AG130”).CurrentRegion
抽出行 = Array(16, 16)
Dim objWs As Worksheet
Set objWs = Sheets.Add(after:=Worksheets(Worksheets.Count))
objWs.Name = Sheets(“シフト”).Range(“AG1”)
For i = 0 To UBound(抽出行)
データ範囲.Rows(抽出行(i)).Copy objWs.Range(“A1”).Offset(0, i)
Next i
End Sub
シート名の値を シフトシートのAG1に変更いたしました
１６行目を取得してます なぜかAの列の値が２つ入ります
別シートに A16 A16 B16 C16～ となぜかA１６の値が２個
またA１６には関数が入れてあるので +#REF! です これは値と書式のみの取得にすれば 良いのでしょうか？
同時に 複数行も取得したいのですが
A16 A18 A20とか 行は飛び飛びです
また、シフトの値を変えた場合再度同じシートを書き換えたいのですが
どうしてもAG1の値で一度新規シートができているので現状エラーが出ます
Dim Key As String ’ キー
Dim Flg As Boolean ’フラグ
Dim She As Worksheet ‘キーに対するシート名
を追加して
For Each She In Worksheets
Flg = False
Key = Worksheets(“シフト”).Range(“AG7”).Value
If She.Name = Key Then
Flg = True
She.Range(“A1:AG130”).ClearContents ‘シートの上書きのため 範囲をクリア
Exit For
End If
Next She
シートがなかったらシートを追加する
If Flg = False Then ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = Key
End If
そしてぐちゃぐちゃになりわけがわからなくなってます
少し形式を変えました 行の検索で バラバラの行を抽出するようにいたしました
精査お願いいたします 他のサイトのものを検証可変したものです
Dim i As Long
Dim mySh As Worksheet
Dim myFlg As Boolean
Dim lastRow As Long, myRow As Long
Dim myK As String
Set myDic = CreateObject(“Scripting.Dictionary”)
‘ —(1)元データの項目を配列に格納
lastRow = Worksheets(“Sheet1”).Range(“E” & Rows.Count).End(xlUp).Row ‘種類列
myVal = Worksheets(“Sheet1”).Range(“E2”, “E” & lastRow).Value ‘種類列
‘ —(2)myDicへデータを格納
For Each c In myVal
If Not c = Empty Then
If Not myDic.Exists(c) Then
myDic.Add c, “”
End If
End If
Next
‘—-振り分け先のシートが存在するか否かをチェック
myKey = myDic.Keys
For i = 0 To myDic.Count – 1
For Each mySh In Worksheets
myFlg = False
If mySh.Name = myKey(i) Then
myFlg = True
mySh.Cells.Delete
Exit For
End If
Next mySh
‘—-振り分け先のシートがなかったらシートを追加する
If myFlg = False Then
ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = myKey(i)
End If
‘—-列見出しをコピー&貼り付け
Worksheets(“Sheet1”).Range(“A1:E1”).Copy Worksheets(myKey(i)).Range(“A1”)
Next i
‘—-データを転記する
For i = 2 To lastRow
myK = Worksheets(“Sheet1”).Range(“E” & i).Value
If myK “” Then
myRow = Worksheets(myK).Range(“E” & Rows.Count).End(xlUp).Row + 1
Worksheets(“Sheet1”).Range(“A” & i & “:E” & i).Copy _
Worksheets(myK).Range(“A” & myRow & “:E” & myRow)
End If
Next i
Set myDic = Nothing
End Sub
うまくいっているようなんですが 式も同時に入るので困っています
書式と値のみにするにはどのようにしたらよいでしょう？
書式と値のみという条件でペーストするには二段階で行う必要があります。
1回目で書式のみコピーして次に値のコピーを行ってます。
以下ご参考ください。
変更前
Worksheets(“Sheet1”).Range(“A” & i & “:E” & i).Copy _
Worksheets(myK).Range(“A” & myRow & “:E” & myRow)
変更後
Worksheets(“Sheet1”).Range(“A” & i & “:E” & i).Copy
Worksheets(myK).Range(“A” & myRow & “:E” & myRow).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
Worksheets(myK).Range(“A” & myRow & “:E” & myRow).PasteSpecial Paste:=xlPasteValues
最高です
完成いたしました あとは 各反応を見ながら 適時修正して
完璧なものに近づけていきたいとおもいます
また困りごとがありましたら 相談させてください
早速 相談完成かと思われましたが 、少し不便が出ました
ユーザーフォームを表示しリストボックスクリック時値ははいります
問題なし
この後の動作で マウスでセルを移動するのですが 矢印での移動も可能にしたいのですが 入力後フォーカスをセルに持っていき自由に移動したいのですが
ユーザーフォーム表示
Sub 入力()
On Error Resume Next
UserForm1.Show vbModeless
With UserForm1
.StartUpPosition = 0
.Top = 20
.Left = 30
End With
On Error GoTo 0
End Sub
リストぼっくクリック
Private Sub ListBox1_Click()
Application.ScreenUpdating = False
On Error Resume Next
Dim i As Integer
With ListBox1
For i = 0 To 5
ActiveCell.Offset(i, 0).Value = .List(.ListIndex, i)
Next i
End With
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
UserForm1.Show vbModeless このモードでセルは移動できるのですが
フォーカスがリストボックスに残ったままで マウス操作になります
ユーザーフォームは開いたまま 入力後は ENTER 矢印などでもセルを
移動したいのですが
ユーザーフォームを表示させた後、セルへフォーカスしキーボードの操作を行う方法につきまして、
いくつかの方法（セルセレクト、ブックアクティブ化など）を検証してみましたが、実現は難しい状況でした。
モードレス表示となっていますので、一度セルやシートをクリックした上キーボードの操作を行っていただければと存じます。
ありがとうございます 私なりにいろいろ試しましたがむつかしいのですね
取り合えづ完成いたしましたありがとうござます