30分ごとの時間帯でGanttチャートを作成する

ユーザーフォーム講座 動画編 03回

動画でExcel　30分ごとの時間帯でGanttチャートを作成する

30分ごとの時間帯でGanttチャートを作成する

今回のGanttチャートは、 30分ごとの時間帯でGanttチャートを作成するにはというものです。
方法はいくつかありますが、まず始めに最初はFor文を使って、範囲の中を回していくというやりかたです。
そしてもう一つは、配列で行うケースです。

【タイムライン】

• 目次
• 00:00 - イントロ
• 00:29 - 内容紹介、月単位のガントチャートの説明
• 01:32 - 月単位のガントチャートを２通り作成
• 02:22 - 該当月をひとつのレクタングルで作成する月単位のガントチャートのコード解説
• 09:41 - 該当月のセルをひとつずつレクタングルで作成する月単位のガントチャートのコード解説
• 14:14 - 次回３０分単位のガントチャートの予告
• 14:19 - コードタイム
• 17:04- End

マクロ動画　30分ごとの時間帯でGanttチャートを作成する

30分単位のガントチャートをFor文だけのマクロと、配列を利用したマクロで２種類

30分のガントチャートをFor文を利用して作るマクロと、配列を利用して作るマクロの２種類を紹介します。

使うシートには工程表2という名前がついており、３行目には時間帯が３０分単位で列見出しとして入力されています。
また４行目以降には、工程ナンバーと工程名が入力されており、開始時間と終了時間列見出しと同じく、３０分単位で入力されています。

最初にFor文で繰り返しながら工程表にレクタングルを描画するコードを見ていただきます。
最初に変数です。
Dim ws As Worksheet、wsはWorksheetを特定するために使う変数です。(変数について 動画内で説明しています。)
Dim startT As Double, endT As Double、これは開始時間と終了時間を表すための変数として使います。

次に、工程表2をwsにセットします。
Set ws = Worksheets("工程表2")
これにより、With ws とwith構文を使う際のシート指定が簡単になります。
with構文の中でFor文を使ってレクタングル作成の為に必要なデータを取得します。
startT = CDbl(.Cells(i, 3).Value)
endT = CDbl(.Cells(i, 4).Value)
colorC = .Cells(i, 5).Interior.Color
shtext = .Cells(i, 2).Value
上記コードで、開始時間と終了時間を変数iで特定したセルから取得し、色と工程名も同様に取得します。

開始時間と終了時間については、CDbl関数を使って、数値に変換しています。

描画する列はどこか、For Each 構文で時間範囲を探す

ここからのコードが３０分ガントチャートでは重要な部分です。
For Each TimRng In .Range("F3:AD3")
時間帯が入力されたレンジの中から、開始時間、終了時間と合致するレンジを探します。
これは列を特定する為です。値が同じだったら、その列を取得します。

開始列と終了列が決まったらガントチャートのレクタングルを描画することができます。
以下のコードでは、開始セルと終了セル、セルのアドレスを作成しています。
' 開始列と終了列が決まったら、レクタングルを描画
If startCol > 0 And endCol > 0 Then
Dim startCe As String, endCe As String
startCe = .Cells(i, startCol).Address
endCe = .Cells(i, endCol).Address

この部分はワークシートのShapes.AddShapeメソッドの引数に、必要なデータを当てはめてレクタングルを描画する部分のコードです。

以下が、この３０分ガントチャートを作成するマクロのコード全体です。

Sub GanttChart_30min_ver1()
    Dim ws As Worksheet
    Dim i As Long, colorC As Long
    Dim startT As Double, endT As Double
    Dim rng As Range, TimRng As Range
    Dim shtext As String
    Dim startCol As Long, endCol As Long

    Set ws = Worksheets("工程表2")
    Application.ScreenUpdating = False
    With ws
        For i = 4 To .Range("A4").CurrentRegion.Rows.Count  'なぜ？
            startT = CDbl(.Cells(i, 3).Value)
            endT = CDbl(.Cells(i, 4).Value)
            colorC = .Cells(i, 5).Interior.Color
            shtext = .Cells(i, 2).Value

            startCol = 0
            endCol = 0
            
            ' 開始時間と終了時間を見つける
            For Each TimRng In .Range("F3:AD3")
                If CDbl(TimRng.Value) = startT Then
                    startCol = TimRng.Column
                ElseIf CDbl(TimRng.Value) = endT Then
                    endCol = TimRng.Column - 1
                End If
            Next TimRng
            
        ' 開始列と終了列が決まったら、レクタングルを描画
            If startCol > 0 And endCol > 0 Then
            Dim startCe As String, endCe As String
            startCe = .Cells(i, startCol).Address
            endCe = .Cells(i, endCol).Address
                
                With .Shapes.AddShape(msoShapeRectangle, .Range(startCe).Left, _
                    .Range(startCe).Top, .Range(endCe).Offset(0, 1).Left - .Range(startCe).Left, _
                    .Range(endCe).Height)
                    .Fill.ForeColor.RGB = colorC
                    .TextFrame.Characters.Text = shtext
                    .TextFrame.Characters.Font.Size = 16
                    .TextFrame.Characters.Font.Bold = True
                    .TextFrame.Characters.Font.Name = "メイリオ"
                End With
                
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

配列を使ってガントチャートを作成する場合

配列を使ってガントチャートを作成する方法では、最初にシートから配列としてレクタングル作成のための情報と、シートの３行目のタイムレンジの情報を取得してしまいます。

これにより、処理速度が大幅に短縮されます。大量のガントチャートを作成する場合には、便利です。

以下のコード部分が配列として取得しているコードです。
' シートからタスクデータと時間データを配列に格納
taskData = ws.Range("B4:D6").Value
timeData = ws.Range("F3:AD3").Value

For i = LBound(taskData, 1) To UBound(taskData, 1)
配列taskDataのLBoundからUBoundまでを繰り返します。
開始時間と終了時間を配列から特定し、同様に描画する色と工程名を取得しています。

以下の部分で配列timeDataから終了時間に合致する列を見つけます。
For j = LBound(timeData, 2) To UBound(timeData, 2)
If CDbl(timeData(1, j)) >= endTime Then
endCol = j + 4
Exit For
End If
Next j

あとは、レクタングルの開始列と終了列を決め、レクタングルを描画するという流れです。

With構文の中で、
ws.Shapes.AddShapeメソッドを使い、ガントチャートのレクタングルを描画します。

以下が、この３０分ガントチャートを作成するマクロのコード全体です。

Sub GanttChart_30min()
    Dim ws As Worksheet
    Set ws = Worksheets("工程表1")
    Dim taskData As Variant, timeData As Variant
    Dim i As Long, j As Long
    Dim startTime As Double, endTime As Double
    Dim startCol As Long, endCol As Long
    Dim colorC As Long, shtext As String
    
    ' シートからタスクデータと時間データを配列に格納
    taskData = ws.Range("B4:D6").Value
    timeData = ws.Range("F3:AD3").Value
    
    For i = LBound(taskData, 1) To UBound(taskData, 1)
        startTime = CDbl(taskData(i, 2))
        endTime = CDbl(taskData(i, 3))
        colorC = ws.Cells(i + 3, 5).Interior.Color ' 行番号調整
        shtext = taskData(i, 1)
        
        ' 配列で時間を検索して開始列を見つける
        For j = LBound(timeData, 2) To UBound(timeData, 2) '1 To 25
            If CDbl(timeData(1, j)) >= startTime Then
                startCol = j + 5 ' 列番号調整（F列から始まるため）
                Exit For
            End If
        Next j
        
        For j = LBound(timeData, 2) To UBound(timeData, 2)
            If CDbl(timeData(1, j)) >= endTime Then
                endCol = j + 4
                Exit For
            End If
        Next j
        
        ' レクタングルの開始列と終了列
        Dim startCe As String, endCe As String
        startCe = ws.Cells(i + 3, startCol).Address
        endCe = ws.Cells(i + 3, endCol).Address
        ' レクタングルを作成
        With ws.Shapes.AddShape(msoShapeRectangle, _
                ws.Range(startCe).Left, ws.Range(startCe).Top, _
                ws.Range(endCe).Offset(0, 1).Left - ws.Range(startCe).Left, _
                ws.Range(endCe).Height)
            .Fill.ForeColor.RGB = colorC
            .TextFrame.Characters.Text = shtext
            .TextFrame.Characters.Font.Size = 12
            .TextFrame.Characters.Font.Bold = True
            .TextFrame.Characters.Font.Name = "メイリオ"
        End With
    Next i
End Sub