[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『カレンダーの内容を担当ごとのタイムスケジュールへ』（ゆゆゆ）
現在、お客さんの担当表を作成しているのですが、途中で行き詰まってしまいましたのでご教授いただけたらうれしいです。
sheet1に月間のカレンダー
A B C D E F
1(開始)(終了)(顧客NO.)(顧客名)(担当者NO.)(担当者) 2 7:00 7:30 1 田中 1 小林 3 8:00 9:00 2 佐藤 1 小林 4 7:30 8:30 3 山田 2 青木 5 6 7 : : 20
6列×20行を１日として、7日*5週の35枠のカレンダーになっています。
顧客NO.と担当者NO.はvlookupとindirectを組み合わせてNO.を入力したら対応する名前が表示される。
sheet2に1日のタイムスケジュール
A B C D E F‥‥AD
1(日付)(曜日)(担当者)7:00 7:30 8:00 8:30‥‥20:00まで30分刻み
2 1 日 小林 田中 佐藤
3 1 日 青木 山田
4 担当者3
5 担当者4
6
：
：
：
31日まで
のように名前を反映、かつ開始から終了までを色づけしたいです。
担当者は現在25名ほどですので1日分に30行ほどつくり2日以降も下に下に表示されるように。
日付と曜日はカレンダーのsheet1に関数を入れていて、sheet2にも反映するようにしています
match関数やif、matchindexなどで試みたのですが、私の力量不足できれいに反映されませんでした。よろしくお願いします。
＜ 使用 Excel：Excel2003、使用 OS：unknown ＞
グラフ化する際、塗りではなく、マクロを使ってShapeの四角を置くと、綺麗に見えます。
1セル塗ってしまうと、上下に隙間がないので、パズルのようになってしまうので。
かといって、一人のデータで複数行使うのも、処理が面倒ですし。
与えられた条件で判らない部分は、Sheet1は月間のカレンダという割には、日情報がない点。
時刻の部分が、実は日付型であり、書式設定で時間だけ表示なのでしょうか？ 複数日にまたがる事は無いですよね？
複数顧客が重複する事はありませんか？ 1行1顧客ならば問題ないですが、1行1担当者だと重なりませんか？
（???） 2015/06/15(月) 13:12
Sheet1は月間のカレンダという割には、日情報がない点。
sheet1に月間のカレンダー A B C D E F 1 日付 曜日 2(開始)(終了)(顧客NO.)(顧客名)(担当者NO.)(担当者) 3 7:00 7:30 1 田中 1 小林 4 8:00 9:00 2 佐藤 1 小林 5 7:30 8:30 3 山田 2 青木 6 7 8 : : 20
日付はF1セルに計算式=IF(MONTH($A$1)<>MONTH($A$1-WEEKDAY($A$1)+COLUMN(A1)+7*(ROW(A1)-1)),"",
$A$1-WEEKDAY($A$1)+COLUMN(A1)+7*(ROW(A1)-1))、曜日はA1〜E1を結合して日曜始まりで固定で入力しています
時刻の部分が、実は日付型であり、書式設定で時間だけ表示なのでしょうか？ 複数日にまたがる事は無いですよね？ 時刻部分は表示形式でh:mmにしていて、複数日にまたがることはないです。
複数顧客が重複する事はありませんか？ 1行1顧客ならば問題ないですが、1行1担当者だと重なりませんか？ 担当者が同一時間に複数人うけもつことはありません。ひとりの担当者につき1顧客です。
初めて質問しますので、至らぬ点が多々あると思いますがよろしくお願いします。
（ゆゆゆ） 2015/06/15(月) 13:48
途中と言うからには、どこまで作れていて、どこが判らない部分か、明確にできますか？
sheet2はmatch やindexをつかえばいいのかなあ。。思いましたが、うまく計算式がつくれず、行き詰っています。
色塗りに関しましては、教えていただきましたマクロに挑戦してみようと思います。
（ゆゆゆ） 2015/06/15(月) 14:52
＞ sheet1に月間のカレンダー ＞ A B C D E F ＞ 1 日付 曜日 ＞ 2(開始)(終了)(顧客NO.)(顧客名)(担当者NO.)(担当者) ＞ 3 7:00 7:30 1 田中 1 小林 ＞ ＞日付はF1セルに計算式=IF(MONTH($A$1)<>MONTH($A$1-WEEKDAY($A$1)+COLUMN(A1)+7*(ROW(A1)-1)),"", ＞ $A$1-WEEKDAY($A$1)+COLUMN(A1)+7*(ROW(A1)-1))、 ＞ ＞曜日はA1〜E1を結合して日曜始まりで固定で入力しています
説明がよく分からないです。
図からすると、A1セルが日付で、F1セルが曜日らしいのですけど、 言葉の説明では、F1セルが日付であるらしい。
どっちが本当なんですか？
現在、実際にA1セルに入っているデータは何ですか？(セルの書式を標準にして、どんな値になっているのか教えてください）
＞6列×20行を１日として、7日*5週の35枠のカレンダーになっています。 この35枠全体のセル範囲を示してください。 例：A3:Z100
（半平太） 2015/06/16(火) 16:54
＞現在、実際にA1セルに入っているデータは何ですか？
(セルの書式を標準にして、どんな値になっているのか教えてください）
A1:E1を結合して"日"と入っています。
F1に日付です。
＞この35枠全体のセル範囲を示してください。
A1:AP100です。
（ゆゆゆ） 2015/06/17(水) 10:19
やはり、よく分からないです。 m(__)m
横に1週間分(日曜から土曜まで）あるんですよね？
すると、何故、F1セルにこの複雑な数式が必要なんでしょうかねぇ・・(コピーして使うのでしょうが、レイアウトに合っているとは思えないのですけど・・） ↓ ＞=IF(MONTH($A$1)<>MONTH($A$1-WEEKDAY($A$1)+COLUMN(A1)+7*(ROW(A1)-1)),"", $A$1-WEEKDAY($A$1)+COLUMN(A1)+7*(ROW(A1)-1))
質問を変えます。 同じ週の月曜日の日付は、何処のセルにどんな数式が入っているのですか？ 次の週の金曜日の日付は、何処のセルにどんな数式が入っているのですか？
（半平太） 2015/06/17(水) 12:17
sheet1
A1に日付(表示形式yyyy"年"m"月")
2行目に曜日(A2:日、B2:月‥G2:土)
3行目から日付(A3に計算式(=IF(MONTH($A$1)<>MONTH($A$1-WEEKDAY($A$1)+COLUMN(A1)+7*(ROW(A1)-1)),"",
$A$1-WEEKDAY($A$1)+COLUMN(A1)+7*(ROW(A1)-1)))
:
7行目まで日付のみのカレンダー
同じくsheet1に
F8:K8を結合して日曜日、L9:Q9に月‥同様に土曜日まで。
K9に日付(計算式(=A3)←上記の日付カレンダーから引っ張ってきました。
F G H I J K列にはそれぞれ
(開始)(終了)(顧客no.)(顧客名)(担当no.)(担当名)が入ります
。
F9:K28が1日分の枠になり、月間の35日分の枠はF9:BA108です。
（ゆゆゆ） 2015/06/17(水) 15:48
A B C D E F‥‥AD
1(日付)(曜日)(担当者)7:00 7:30 8:00 8:30‥‥20:00まで30分刻み
2 1 日 小林 田中 佐藤
3 1 日 青木 山田
4 担当者3
5 担当者4
6
：
：
：
31日まで
のように顧客名を反映、かつ開始から終了までを色づけしたいです。
担当者は現在25名ほどですので1日分に30行ほどつくり2日以降も下に下に表示されるように。
（ゆゆゆ） 2015/06/17(水) 15:54
素朴な疑問なんですけど、 Sheet1は日曜日から始まる予定表で「5週まで」ですよね？ 一方、Sheet2は一日から始まる1箇月の表ですよね？
31日まである月は、月初が金曜とか土曜日とかだと「6週」必要になる と思えるのですけど、どう考えたらいいのでしょうか？
第1週が日曜から始まらないときは、日曜になるまでの日は、Sheet2にアウトプットする必要はないと云うことですか？ (それは、前月の最終週に載せるなどしている？）
（半平太） 2015/06/17(水) 17:35
＞第1週が日曜から始まらないときは、日曜になるまでの日は、Sheet2にアウトプットする必要はないと云うことですか？ (それは、前月の最終週に載せるなどしている？）
sheet2は常に1日から表示したいです。
私が考えたのはsheet2のA列にsheet1のカレンダーから日付をとばして、
あとから▽で空白以外を表示にしようと思ってました。
ですがそれ以外によい方法があるならば、そちらの方法で運用したいです。
（ゆゆゆ） 2015/06/17(水) 19:09
よろしくお願いします。
（ゆゆゆ） 2015/06/18(木) 09:08
済みません。レイアウトは当初に戻させて頂きます。 A2:AD121になります。(後記レイアウトご参照ください）
１．数式埋め込み処理(1回実行して終わり。数式を壊さなければ、2度と使わない）)
’Sheet1の数式等入力マクロ(Sheet1のシートモジュールに貼り付けて１回だけ実行)
↓
Private Sub onlyOnce()
Rem 数式セルをまとめて処理
Range("AP2").FormulaR1C1Local = "=R[-1]C[-41]-DAY(R[-1]C[-41])+8-WEEKDAY(R[-1]C[-41]-DAY(R[-1]C[-41])+1)"
Range("F2,L2,R2,X2,AD2,AJ2,F22,L22,R22,X22,AD22,AJ22,AP22").FormulaR1C1Local = "=IF(MONTH(R2C42+(ROW(RC)-2)/20*7-(42-COLUMN(RC))/6)<>MONTH(R1C1),"""",R2C42+(ROW(RC)-2)/20*7-(42-COLUMN(RC))/6)"
Range("F42,L42,R42,X42,AD42,AJ42,AP42,F62,L62,R62,X62,AD62,AJ62,AP62").FormulaR1C1Local = "=IF(MONTH(R2C42+(ROW(RC)-2)/20*7-(42-COLUMN(RC))/6)<>MONTH(R1C1),"""",R2C42+(ROW(RC)-2)/20*7-(42-COLUMN(RC))/6)"
Range("F82,L82,R82,X82,AD82,AJ82,AP82,F102,L102,R102,X102,AD102,AJ102,AP102").FormulaR1C1Local = "=IF(MONTH(R2C42+(ROW(RC)-2)/20*7-(42-COLUMN(RC))/6)<>MONTH(R1C1),"""",R2C42+(ROW(RC)-2)/20*7-(42-COLUMN(RC))/6)"
Rem 標準外書式セルをまとめて処理
Range("F2,L2,R2,X2,AD2,AJ2,AP2,F22,L22,R22,X22,AD22,AJ22,AP22,F42,L42,R42,X42,AD42,AJ42,AP42,F62,L62").NumberFormatLocal = "yyyy/m/d(aaa);@"
Range("R62,X62,AD62,AJ62,AP62,F82,L82,R82,X82,AD82,AJ82,AP82,F102,L102,R102,X102,AD102,AJ102,AP102").NumberFormatLocal = "yyyy/m/d(aaa);@"
End Sub
２．本体のマクロ（Sheet2のシートモジュールに貼り付ける）
Sheet2をアクティブにすると実行(=更新)されるマクロです。
※強制的に実行したい場合は、「Coloring」を手動で実行してください。
A1セルに希望する月の日付を手入力してください。
(常識的には月初ですけど、いつの日付でも構いません)
Private Sub Worksheet_Activate()
Call coloring
End Sub
Public sub coloring()
Const staffBlock As String = "F4:F21"
Const oneDayBlock As String = "A4:F21"
Const oneDayBlockRows As Long = 20
Dim Sh1 As Worksheet
Dim baseDate As Date
Dim dicStaff As Object 'Dictionary
Dim dicSchedule As Object 'Dictionary
Dim cel As Range
Dim eachRow As Range
Dim strThisMonth As String
Dim endOfPrevMon As Date
Dim endOfThisMon As Date
Dim NN As Long, KK As Long
Dim staff
Dim numOfStaff As Long '担当者数
Dim combKey As String
Dim timeKubun(1 To 29) ' 3枠(日,曜日,担当者) + 13時間ｘ2分割
Dim tempTK
Dim blockRange As Range
Set Sh1 = Sheets("Sheet1")
baseDate = Sh1.Range("A1").Value
Set dicStaff = CreateObject("Scripting.dictionary")
Set dicSchedule = CreateObject("Scripting.dictionary")
'全担当者を把握
For KK = 2 To 2 + oneDayBlockRows * 6 Step oneDayBlockRows
For NN = 6 To 6 + 7 * 6 Step 6
For Each cel In Sh1.Range(staffBlock).Offset(KK - 2, NN - 6)
If cel.Value <> "" Then
dicStaff(cel.Value) = Empty
End If
Next
Next NN
Next KK
'空登録→日付>担当者名>時刻割(顧客名)
strThisMonth = Format(baseDate, "yyyymm")
endOfPrevMon = baseDate - Day(baseDate)
endOfThisMon = DateSerial(Year(baseDate), Month(baseDate) + 1, 0)
For NN = 1 To Day(endOfThisMon)
For Each staff In dicStaff.Keys
combKey = endOfPrevMon + NN & staff
timeKubun(1) = endOfPrevMon + NN
timeKubun(2) = Format(timeKubun(1), "aaa")
timeKubun(3) = staff
dicSchedule(combKey) = timeKubun
Next
Next NN
numOfStaff = dicStaff.Count
dicStaff.RemoveAll
'実データ埋め込み
For KK = 2 To 2 + oneDayBlockRows * 6 Step oneDayBlockRows
For NN = 6 To 6 + 7 * 6 Step 6
Set blockRange = Sh1.Range(oneDayBlock).Offset(KK - 2, NN - 6)
For Each eachRow In blockRange.Rows
If Format(blockRange.Rows(1).Cells(-1, 6).Value, "yyyymm") = strThisMonth Then
If eachRow.Cells(1, 4).Value <> "" And eachRow.Cells(1, 6).Value <> "" Then
combKey = blockRange.Cells(-1, 6).Value & eachRow.Cells(1, 6)
tempTK = dicSchedule(combKey)
Call assigning(eachRow, tempTK)
dicSchedule(combKey) = tempTK
ElseIf (eachRow.Cells(1, 4).Value = "" And eachRow.Cells(1, 6).Value <> "") Or _
(eachRow.Cells(1, 6).Value = "" And eachRow.Cells(1, 4).Value <> "") Then
MsgBox "範囲" & blockRange.Address(0, 0) & "の担当者又は顧客が空白です。→ 処理中止" & vbCrLf & _
eachRow.Cells(1, 4).Value & " " & eachRow.Cells(1, 4).Value
Exit Sub
End If
End If
Next
Next NN
Next KK
Application.ScreenUpdating = False ’整形処理
Cells.ClearContents
Range("A2:B621").UnMerge
For NN = 1 To Day(endOfThisMon) 'セルの結合を済ませておく
Range("A" & (NN - 1) * numOfStaff + 2).Resize(numOfStaff, 1).Merge
Range("B" & (NN - 1) * numOfStaff + 2).Resize(numOfStaff, 1).Merge
Next NN
Range("A1").Value = "(日付)"
Range("B1").Value = "(曜日)"
Range("C1").Value = "(担当者)"
Range("D1").Value = TimeValue("7:00")
Rem 数式セル
Range("E1:AC1").FormulaR1C1Local = "=TEXT(RC[-1]+""0:30"",""h:mm"")*1"
Rem 標準外書式セル
Range("D1:AC1").NumberFormatLocal = "h:mm""〜"""
Range("A2").Resize(dicSchedule.Count, 29).Value = _
Application.Index(dicSchedule.Items, 0, 0)
Call fmtCondition ’条件付き書式を設定する
Application.ScreenUpdating = True
End Sub
Private Sub assigning(ByRef eachRow, ByRef tempTK) '顧客名埋め込みサブ
Dim i As Long, st As Long, ed As Long
With Application
st = Int((eachRow.Cells(1, 1).Value2 + TimeValue("0:00:01")) * 48) - 10
st = .Max(st, 4)
ed = Int((eachRow.Cells(1, 2).Value2 - TimeValue("0:00:01")) * 48) - 10
ed = .Max(st, .Min(ed, 29))
End With
For i = st To ed
tempTK(i) = tempTK(i) & eachRow.Cells(1, 4).Value
Next i
End Sub
Private Sub fmtCondition() '条件付書式設定サブ
Range("D2").Activate
With Range("D2:AC621")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(NOT(ISBLANK(D2)),MOD(ROW(),2))"
.FormatConditions(1).Interior.ColorIndex = 33
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(NOT(ISBLANK(D2)),MOD(ROW()+1,2))"
.FormatConditions(2).Interior.ColorIndex = 6
End With
Range("C2").Activate
With Range("C2:C621")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(COUNTIF(D2:AC2,""*""),MOD(ROW(),2))"
.FormatConditions(1).Interior.ColorIndex = 33
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(COUNTIF(D2:AC2,""*""),MOD(ROW()+1,2))"
.FormatConditions(2).Interior.ColorIndex = 6
End With
End Sub
<Sheet1 レイアウト> 行 ___A___ ___B___ ___C___ ___D___ ___E___ ___F___ __G__ __H__ ___I___ ___J___ ___K___ _____ L _____ 1 6月1日 の予定 2 2015/6/1(月) 3 開始 終了 顧客NO 顧客名 担当NO 担当者 開始 終了 顧客NO 顧客名 担当NO 担当者 4 7:00 7:30 1 田中 1 小林 5 8:00 9:00 2 佐藤 1 小林 6 7:30 8:30 3 山田 2 青木
<Sheet2 レイアウト> 行 ____A____ __B__ ___C___ ___D___ ___E___ ___F___ ___G___ 1 日付 曜日 担当者 7:00〜 7:30〜 8:00〜 8:30〜 2 2015/6/1 月 小林 田中 佐藤 佐藤 3 青木 山田 山田 4 赤草 5 akita 6 大林 7 中森 8 小谷 9 2015/6/2 火 小林 10 青木 11 赤草 12 akita 13 大林 14 中森 15 小谷
（半平太） 2015/06/18(木) 12:24
マクロについては数式以上に勉強不足ですので、またわからないところがでてくると思いますが、よろしくお願いします。
（ゆゆゆ） 2015/06/18(木) 14:07
いえ、1日分は6列です。
6月1日は月曜なので、6月のデータはG列がスタートになります。
マクロ「onlyOnce」を実行すれば、日付用の数式が6列毎に入力されます。
A列の最初のブロックは、5月に属するので、空白("")の表示になり、目には見えません。
（半平太） 2015/06/18(木) 15:46
＞ A1セルに希望する月の日付を手入力してください。 ＞ (常識的には月初ですけど、いつの日付でも構いません)
済みません。このA1セルはSheet1のA1セルのことです。紛らわしい書き方ですみません。m(__)m
（半平太） 2015/06/18(木) 20:17
また、後だしになってしまい本当に申し訳ないのですが、
sheet2の担当者名はその日に予定が入っていなくとも全員表示することは可能でしょうか？
具体的にいいますと、担当者は現在25名ほどですが
追加される可能性もあるので担当者枠を40人ほどにして表示可能でしょうか？
（ゆゆゆ） 2015/06/19(金) 10:02
＞教えていただいたマクロをシートに登録して架空の予定をsheet1に入力してみました。 ＞sheet2ですが、日付、曜日、横方向に30分刻みで表示される時間はでてきたのですが、 ＞ 顧客名が反映されませんでした。 ＞マクロを貼り付けて、データをsheet1に入力する以外になにか ＞私がすべきはありますでしょうか？
いえ、ありません。
以下のデータをテスト的に入力して、Sheet2がどうなるか教えてください。 <Sheet1> 行 ____A____ ___B___ ___C___ ___D___ ___E___ ___F___ __G__ __H__ ___I___ ___J___ ___K___ ____L____ 1 2015/6/1 2 2015/6/1 3 開始 終了 顧客NO 顧客名 担当NO 担当者 開始 終了 顧客NO 顧客名 担当NO 担当者 4 7:30 9:00 1 田中 1 小林 5 7:00 8:00 2 田上 2 中林
私の環境では、下図になるんですけど。
<Sheet2 結果図> 行 ____A____ ___B___ ____C____ ___D___ ___E___ ___F___ ___G___ ___H___ 1 (日付) (曜日) (担当者) 7:00〜 7:30〜 8:00〜 8:30〜 9:00〜 2 2015/6/1 月 小林 田中 田中 田中 3 中林 田上 田上 4 2015/6/2 火 小林 5 中林
＞sheet2の担当者名はその日に予定が入っていなくとも全員表示することは可能でしょうか？
Sheet1に表示されている担当者は全て表示されるようになっています。(全然出番がない日でも） 逆に、Sheet1のどこにも表示されていない担当者(前月と来月には顔を出す人）は、表示されません また、余分な空行も作りません。
（半平太） 2015/06/19(金) 10:44
上司に確認してもらい、こちらの表で運用することになりました。
担当者の表示の件も、説明していただき理解できました。
一点、上司からのリクエストなのですが、
sheet2の色づけされる色はマクロのcolorindexのところに任意の色コードを入力することで
全員同じ色(うすい灰色)にすることは可能でしょうか？
（ゆゆゆ） 2015/06/19(金) 11:37
＞3行目の項目名を入力しておらず、入力したら表示されました！
そんなハズないんですけどねぇ・・ （3行目は見に行っていないので） 2行目(日付がある行）の間違いじゃないですか・・まぁ、旨く行ったのならそれでいいですけど。
＞sheet2の色づけされる色はマクロのcolorindexのところに任意の色コードを入力することで ＞全員同じ色(うすい灰色)にすることは可能でしょうか？
ColoIndexの番号を変えれば可能です。
.FormatConditions(1).Interior.ColorIndex = 33 ’←この数字を変える
.FormatConditions(2).Interior.ColorIndex = 6 ’←この数字を変える
※全員同じ色にするとみづらくなると思いますよ・・・まぁ、そちらの勝手ですけどね。 「うすい灰色」が何番なのかはそちらで調べてください（色づけを「マクロの記録」で記録して、作成されたコードを見ればすぐ分かります） 私のコードは奇数行と偶数行で別の色になる様にしてありますので、簡単に対応するには、二つとも同じ番号にすればいいです。
※条件付き書式の部分は、バージョンがXL2003以前であることを想定しております。 なので、XL2007以降では使えないコードなのでお含み置きください。
まぁ、正しく条件付書式が設定されたら、再設定する必要もないので、 業務が軌道に乗ったら、下の１行を削除しておくといいです。 (それならバージョンは何であっても動きます）
Call fmtCondition ’条件付き書式を設定する
（半平太） 2015/06/19(金) 12:21
追記
Sheet1の作表過程で日付用の数式を壊しているといけないので、 最終段階で「onlyOnce()」をもう一度実行した方がいいと思っています。
※AP2セルの数式だけ特殊なので下手にコピーされているとトラぶります。 その他の数式はコピー作業で壊れることはないですけど。
（半平太） 2015/06/19(金) 12:47
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.