Excel VBA 質問スレッド No.32 (未解決)

VBAでガントチャート作成したいです。

投稿者 : ピンチ     投稿日時 : 2017/05/23(Tue) 19:33:44     OS : 未指定     EXCEL : その他
初投稿です。
VBA初心者なのですが、仕事でVBAでガントチャートの作成を頼まれました。

シート1に全体の表があります。
A列 番号
B列 品名
C列 担当者
D列 機械名
E列 開始日
F列 完了日
G列以降 開始日から完了日までのスケジュール

シート2には担当者別の負荷状況カレンダーがあります。
A列 担当者名
B列 担当業務
G列 予実(予定、実績、リスケ が縦にあります)
H列以降 カレンダー(月)

シート3には機械別の負荷状況カレンダーがあります。
A列 機械名
F列 予実(予定、実績、リスケ が縦にあります)
G列以降 カレンダー(月)

シート1に担当者、機械名、開始日、完了日記入したら
シート2とシート3にガントチャートが作成されるようにしたいです。

例えば、担当者鈴木 機械名S1 開始日6/1 完了日6/5 と入力したら
シート2には担当者鈴木の予定の行に6/1〜6/5まで印がつく
シート3には機械名S1の予定の行に6/1〜6/5まで印がつくようにしたいです。

VBAの基本的なやり方は調べたのですが、どういったモジュールを作成していいかわかりません。
上記のやり方は難しいとか他にやりやすいやり方がそれもあれば教えて頂きたいです。
よろしくお願いします。

[返信 1] Re : VBAでガントチャート作成したいです。
投稿者 : 管理人     投稿日時 : 2017/05/27(Sat) 23:10:31
返答が遅くなってしまったので、すでに解決しているかもしれませんが、
一応サンプルを掲載しておきます。


Sub sample()

Const COL_ZENAI_TANTO = 3
Const COL_ZENAI_KIKAI = 4
Const COL_ZENAI_KAISI = 5
Const COL_ZENAI_OWARI = 6

Dim wsZentai As Worksheet
Dim wsTanto As Worksheet
Dim wsKikai As Worksheet

Dim rngTanto As Range
Dim rngTantoCal As Range
Dim rngKikai As Range
Dim rngKikaiCal As Range
Dim maxRow As Integer
Dim maxCol As Integer

Application.ScreenUpdating = False

Set wsZentai = Worksheets("全体")
Set wsTanto = Worksheets("担当者別")
Set wsKikai = Worksheets("機械別")

' 担当者別シート
maxRow = wsTanto.Cells(Rows.Count, 1).End(xlUp).Row
maxCol = wsTanto.Cells(1, Columns.Count).End(xlToLeft).Column

Set rngTanto = wsTanto.Range("A2:A" & maxRow)
Set rngTantoCal = wsTanto.Range(wsTanto.Range("H1"), _
wsTanto.Cells(1, maxCol))

' 機械別シート
maxRow = wsKikai.Cells(Rows.Count, 1).End(xlUp).Row
maxCol = wsKikai.Cells(1, Columns.Count).End(xlToLeft).Column

Set rngKikai = wsKikai.Range("A2:A" & maxRow)
Set rngKikaiCal = wsKikai.Range(wsKikai.Range("G1"), _
wsKikai.Cells(1, maxCol))

' ループ内で使用する変数
Dim zentaiRow As Integer
Dim strTanto As String
Dim strKikai As String
Dim dtKaisi As Date
Dim dtOwari As Date
Dim nameRow As Integer
Dim kaisiCol As Integer
Dim owariCol As Integer

zentaiRow = 2

Do Until wsZentai.Cells(zentaiRow, COL_ZENAI_TANTO).Value = ""

strTanto = wsZentai.Cells(zentaiRow, COL_ZENAI_TANTO).Value
strKikai = wsZentai.Cells(zentaiRow, COL_ZENAI_KIKAI).Value
dtKaisi = CDate(wsZentai.Cells(zentaiRow, COL_ZENAI_KAISI).Value)
dtOwari = CDate(wsZentai.Cells(zentaiRow, COL_ZENAI_OWARI).Value)

' 担当者別
nameRow = SearchName(rngTanto, strTanto)
kaisiCol = SearchDate(rngTantoCal, dtKaisi)
owariCol = SearchDate(rngTantoCal, dtOwari)

If nameRow > 0 And kaisiCol > 0 And kaisiCol < owariCol Then

' 担当者別シートの該当カレンダーに機械名を設定
wsTanto.Range(wsTanto.Cells(nameRow, kaisiCol), _
wsTanto.Cells(nameRow, owariCol)).Value = strKikai

End If

' 機械別
nameRow = SearchName(rngKikai, strKikai)
kaisiCol = SearchDate(rngKikaiCal, dtKaisi)
owariCol = SearchDate(rngKikaiCal, dtOwari)

If nameRow > 0 And kaisiCol > 0 And kaisiCol < owariCol Then

' 機械別シートの該当カレンダーに担当者名を設定
wsKikai.Range(wsKikai.Cells(nameRow, kaisiCol), _
wsKikai.Cells(nameRow, owariCol)).Value = strTanto

End If

zentaiRow = zentaiRow + 1
Loop


Application.ScreenUpdating = True

MsgBox "ガントチャートを作成しました。", vbInformation

End Sub

' 担当者名、機械名検索用プロシージャ
Function SearchName(pRng As Range, pName As String) As Integer

SearchName = 0

Dim c As Range
For Each c In pRng.Cells
If c.Value = pName Then
SearchName = c.Row
Exit Function
End If
Next

End Function

' 日付検索用プロシージャ
Function SearchDate(pRng As Range, pDate As Date) As Integer

SearchDate = 0

Dim c As Range
For Each c In pRng.Cells
If CDate(c.Value) = pDate Then
SearchDate = c.Column
Exit Function
End If
Next

End Function

スポンサード リンク
 
 
当掲示板について
返信入力フォーム
お 名 前  :
内  容   :
ステータス  : この質問を解決済みにする

認証コード  :
        キャプチャ画像


( 処理日時 : 2019-06-17 03:56:44 )

Page
Top