Option Explicit
Dim G_Gyo As Long
Dim G_GyoMx As Long
Dim G_Cnt As Long
'[12] 演習問題1: 各自で自由にアレンジしてガントチャートを作成する (本講座参加者でシェアします)
'[13] 演習問題2: 各部署向けのガントチャートを生成するマクロを作る (同一ファイル内)
'作成日2018.4.30 15:00
Sub Zentai()
DeleteScheduleGraphSheets
SetCatList
SortByCat
CreateScheduleGraphSheets
SortByID
End Sub
Sub DeleteScheduleGraphSheets()
Dim c As Long
Application.DisplayAlerts = False
'削除するシートの指定方法はいろいろ考えられますね ogawa
For c = Worksheets.Count To 6 Step -1
Worksheets(c).Delete
Next
Application.DisplayAlerts = True
End Sub
Sub SetCatList()
'元データ(シート名:List)への、カテゴリidの割り振り (並べ替え用)
'発展編1レベルであれば .Find メソッド。発展編2レベルであれば連想配列を使って解決するとより高速です ogawa
Dim wFm As Worksheet
Dim wTo As Worksheet
Set wFm = Worksheets("CatList")
Set wTo = Worksheets("List")
Dim cFm As Long
Dim cTo As Long
Dim cMxFm As Long
Dim cMxTo As Long
cMxFm = wFm.Range("A" & wFm.Rows.Count).End(xlUp).Row
cMxTo = wTo.Range("C" & wFm.Rows.Count).End(xlUp).Row
For cTo = 4 To cMxTo
For cFm = 2 To cMxFm
If wTo.Range("C" & cTo).Value = wFm.Range("B" & cFm).Value Then
wTo.Range("B" & cTo).Value = wFm.Range("A" & cFm).Value
Exit For
End If
Next
Next
End Sub
Sub SortByCat()
'元データ(シート名:List)並べかえ (sortid, アクション,日付)
Dim w As Worksheet
Set w = Worksheets("List")
Dim cMx As Long
cMx = w.Range("C" & w.Rows.Count).End(xlUp).Row
Dim rg As Range
Set rg = w.Range("A3:I" & cMx)
rg.Sort Key1:=w.Range("B4"), _
Order1:=xlAscending, _
Key2:=w.Range("D4"), _
Order2:=xlAscending, _
Key3:=w.Range("H4"), _
Order3:=xlAscending, _
Header:=xlYes
End Sub
Sub SortBySection()
'元データ(シート名:List)並べかえ (担当部署)
Dim w As Worksheet
Set w = Worksheets("List")
Dim cMx As Long
cMx = w.Range("C" & w.Rows.Count).End(xlUp).Row
Dim rg As Range
Set rg = w.Range("A3:I" & cMx)
rg.Sort Key1:=w.Range("G4"), _
Order1:=xlAscending, _
Header:=xlYes
End Sub
Sub SortByID()
'元データ(シート名:List)の並びを元に戻す
Dim w As Worksheet
Set w = Worksheets("List")
Dim cMx As Long
cMx = w.Range("C" & w.Rows.Count).End(xlUp).Row
Dim rg As Range
Set rg = w.Range("A3:I" & cMx)
rg.Sort Key1:=w.Range("A4"), _
Order1:=xlAscending, _
Header:=xlYes
End Sub
Sub CreateScheduleGraphSheets()
'全部門用のシートを準備する
Dim wFm As Worksheet
Dim wTo As Worksheet
Set wFm = Worksheets("ScheduleGraph_Template")
wFm.Copy after:=Worksheets(Worksheets.Count)
Set wTo = Worksheets(Worksheets.Count)
wTo.Name = "ScheduleGraph"
Dim c As Long
Dim w As Worksheet
Set w = Worksheets("List")
Dim cMx As Long
cMx = w.Range("C" & w.Rows.Count).End(xlUp).Row
G_Gyo = 4 '定数を使うというのもありそう ogawa
G_GyoMx = cMx
'↓以下2つ、分割上手いですね。
CreateListToScheduleGraph
SortBySection
'各部署用のシートを準備する
Set wFm = Worksheets("ScheduleGraph_Template")
For c = 4 To cMx
If w.Range("G" & c).Value <> w.Range("G" & c - 1).Value Then
wFm.Copy after:=Worksheets(Worksheets.Count)
Set wTo = Worksheets(Worksheets.Count)
wTo.Name = w.Range("G" & c).Value
wTo.Range("C1").Value = c
Else
wTo.Range("C2").Value = c
End If
Next
For G_Cnt = 7 To Worksheets.Count
G_Gyo = Worksheets(G_Cnt).Range("C1").Value
G_GyoMx = Worksheets(G_Cnt).Range("C2").Value
'↓インデントひとつよけい ogawa
CreateListToScheduleGraph
'以下2行は、左辺の変数不要。 ogawa
G_Gyo = Worksheets(G_Cnt).Range("C1").ClearContents
G_GyoMx = Worksheets(G_Cnt).Range("C2").ClearContents
Next
End Sub
'発展編2レベルになると、引数つきプロシージャを使い、さらにひきしまったプログラムを書けるようになります。
' モジュールレベル変数不要に
' Worksheets(G_Cnt).Range("C1"), Worksheets(G_Cnt).Range("C2") への値投入不要に ogawa
Sub CreateListToScheduleGraph()
Dim cFm As Long
Dim cTo As Long
Dim cMxFm As Long
Dim cMxTo As Long
Dim wFm As Worksheet
Set wFm = Worksheets("List")
'変数wToを切り替え
Dim wTo As Worksheet
Dim c As Long
If Worksheets(Worksheets.Count).Name = "ScheduleGraph" Then
Set wTo = Worksheets(Worksheets.Count)
Else
Set wTo = Worksheets(G_Cnt)
End If
cMxFm = wFm.Range("C" & wFm.Rows.Count).End(xlUp).Row
cTo = 6
Dim dFm As Date
Dim dTo As Date
Dim cDiff As Long
wTo.Range("A1").Value = wFm.Range("A1").Value
'以下、適切なタイミングでのコメントがとても秀逸です。 ogawa
Dim sCom As String
'レポートシートを作る
For cFm = G_Gyo To G_GyoMx
'カテゴリアクションのリストを作り、A列とB列に書き出す
If wFm.Range("C" & cFm - 1).Value <> wFm.Range("C" & cFm).Value Then
wTo.Range("A" & cTo).Value = wFm.Range("C" & cFm).Value
cTo = cTo + 1
wTo.Rows(cTo).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wTo.Range("B" & cTo).Value = wFm.Range("D" & cFm).Value
cTo = cTo + 1
wTo.Rows(cTo).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ElseIf wFm.Range("D" & cFm - 1).Value <> wFm.Range("D" & cFm).Value Then
wTo.Range("B" & cTo).Value = wFm.Range("D" & cFm).Value
cTo = cTo + 1
wTo.Rows(cTo).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
'注意点のリストをC列に書き出す
If wFm.Range("F" & cFm).Value <> "" Then
If wTo.Range("C" & cTo - 1).Value = "" Then
wTo.Range("C" & cTo - 1).Value = wFm.Range("F" & cFm).Value
ElseIf InStr(wTo.Range("C" & cTo - 1).Value, wFm.Range("F" & cFm).Value) = 0 Then
wTo.Range("C" & cTo - 1).Value = wTo.Range("C" & cTo - 1).Value & ":" & wFm.Range("F" & cFm).Value
End If
End If
'カテゴリがある列に色を塗る
If wTo.Range("A" & cTo - 2) <> "" Then
wTo.Range(wTo.Range("A" & cTo - 2), wTo.Range("BRA" & cTo - 2)).Interior.ColorIndex = 35
End If
dFm = wTo.Range("D4").Value
dTo = wFm.Range("H" & cFm).Value
cDiff = DateDiff("d", dFm, dTo)
'ガントチャート内でイベントのある日に色を塗っている部分
If wFm.Range("I" & cFm).Value <> "DONE" Then
'ガントチャート内でイベントを記入
wTo.Range("D" & cTo - 1).Offset(, cDiff).Value = "▽" & wFm.Range("E" & cFm).Value & "(" & Mid(dTo, 6) & ")"
wTo.Range("D" & cTo - 1).Offset(, cDiff).Font.Bold = False '★
wTo.Range("D" & cTo - 1).Offset(, cDiff).Font.ColorIndex = 1 '★
Else
'ガントチャート内でイベントを記入
wTo.Range("D" & cTo - 1).Offset(0, cDiff).Value = "▼" & wFm.Range("E" & cFm).Value & "(" & Mid(dTo, 6) & ")" '★
wTo.Range("D" & cTo - 1).Offset(0, cDiff).Font.Bold = False '★
wTo.Range("D" & cTo - 1).Offset(0, cDiff).Font.ColorIndex = 1 '★
End If
wTo.Range("D" & cTo - 1).Offset(, cDiff).Interior.Pattern = xlGray16 '★
'コメントを入れる部分
If wFm.Range("F" & cFm).Value <> "" Then
If wTo.Range("D" & cTo - 1).Offset(, cDiff).Comment Is Nothing Then
wTo.Range("D" & cTo - 1).Offset(, cDiff).AddComment
wTo.Range("D" & cTo - 1).Offset(, cDiff).Comment.Visible = False
wTo.Range("D" & cTo - 1).Offset(, cDiff).Comment.Text Text:=wFm.Range("F" & cFm).Value
Else
sCom = wTo.Range("D" & cTo - 1).Offset(, cDiff).Comment.Text
wTo.Range("D" & cTo - 1).Offset(, cDiff).Comment.Text Text:=sCom & vbNewLine & wFm.Range("F" & cFm).Value
End If
End If
Next
wTo.Rows(cTo).Delete Shift:=xlUp
cMxTo = wTo.Range("B1048576").End(xlUp).Row
Dim cHida As Long
Dim cMigi As Long
Dim cYoko As Long
For cTo = 6 To cMxTo
If wTo.Range("B" & cTo).Value <> "" Then
'↓発展編1レベルでは For Each構文を使いたいところ。 ogawa
cHida = wTo.Range("C" & cTo).End(xlToRight).Column - 3
cMigi = wTo.Range("XFD" & cTo).End(xlToLeft).Column - 3
For cYoko = cHida To cMigi
If wTo.Range("C" & cTo).Offset(0, cYoko).Value = "" Then
wTo.Range("C" & cTo).Offset(0, cYoko).Interior.ColorIndex = 19
Else
'セル内の文字列を左寄せ/中央揃え/右寄せ
If cYoko = cHida Then
wTo.Range("C" & cTo).Offset(, cYoko).HorizontalAlignment = xlLeft
ElseIf cYoko = cMigi Then
wTo.Range("C" & cTo).Offset(, cYoko).HorizontalAlignment = xlLeft
Else
wTo.Range("C" & cTo).Offset(, cYoko).HorizontalAlignment = xlLeft
End If
End If
Next
End If
Next
'日付の最小値・最大値を調べる
'↓うまいです ogawa
Dim rng As Range
Set rng = wFm.Range("H4" & ":" & "H" & cMxFm)
Dim dMin As Date
Dim dMax As Date
dMin = WorksheetFunction.Min(rng)
dMax = WorksheetFunction.Max(rng)
'必要な列のみ表示
cDiff = DateDiff("d", dFm, dMin) - 7
wTo.Range(wTo.Range("D4"), wTo.Range("D4").Offset(0, cDiff)).EntireColumn.Hidden = True
wTo.Activate
'ウィンド枠の固定
wTo.Range("D6").Offset(0, cDiff + 1).Select
ActiveWindow.FreezePanes = True
cDiff = DateDiff("d", dFm, dMax) + 7
wTo.Range(wTo.Range("D4").Offset(0, cDiff), wTo.Range("BRA4")).EntireColumn.Hidden = True
'列幅調整
wTo.Range(wTo.Range("B4"), wTo.Range("C4")).EntireColumn.AutoFit
Worksheets("ScheduleGraph").Activate
End Sub
T.S.さんの投稿
(投稿ID: 3861) 添付ファイルのダウンロード権限がありません
[13] 演習問題2: 各部署向けのガントチャートを生成するマクロを作る(同一ファイル内)
の作成が完了しました。よろしくお願いいたします。
私の会社では、ガンチャートのイベントを▼、▽で表現する方が多いので
会社で使えるように作成しました。
各部署向けのガントチャートを生成する際にデータを削除する方法でなく
一つ一つデータを転記するところが難しかったです。
小川慶一さんのコメント
(コメントID: 5387)
添削を返送します。
今でも十分に実務利用可能と思います。
部署ごとシートの作成アイデア、すばらしいです。そして、色合いもキレイでよいですね (^^*
基本的な力がとてもしっかりあるということがよく伝わってくるマクロです。
さらにブラッシュアップできるとよいですね。
> [12] 演習問題1: 各自で自由にアレンジしてガントチャートを作成する
> [13] 演習問題2: 各部署向けのガントチャートを生成するマクロを作る(同一ファイル内)
> の作成が完了しました。よろしくお願いいたします。
>
> 私の会社では、ガンチャートのイベントを▼、▽で表現する方が多いので
> 会社で使えるように作成しました。
>
> 各部署向けのガントチャートを生成する際にデータを削除する方法でなく
> 一つ一つデータを転記するところが難しかったです。
T.S.さんのコメント
(コメントID: 5410)
添削下さり、ありがとうございます。
本教材でわからない(あやふや)な点を基礎編、発展編等の関連講座
を見て復習しています。
次は、「ガントチャート作成講座アドバンスド講座 」の演習に
進みたいと思います。
> T.S.さん:
>
> 添削を返送します。
小川慶一さんのコメント
(コメントID: 5413)
お楽しみください。
ここまでのものを自力で作られたのであれば、まず安心です。
> 小川先生
>
> 添削下さり、ありがとうございます。
> 本教材でわからない(あやふや)な点を基礎編、発展編等の関連講座
> を見て復習しています。
> 次は、「ガントチャート作成講座アドバンスド講座 」の演習に
> 進みたいと思います。
>
> > T.S.さん:
> >
> > 添削を返送します。
>