質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

2636閲覧

ガントチャート VBA 描写について

Mkasai

総合スコア19

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

1クリップ

投稿2020/06/19 05:46

前提・実現したいこと

開始日と終了日が入力されている行のみ塗りつぶしを行いたい。
ボタンを押さなくても入力後エンターキーで実行できるようにする方法があるのかどうか。

発生している問題・エラーメッセージ

開始日と終了日を入力していない行も塗りつぶされるので、どの部分を修正したらいいのかわからない。
また、38行目にも開始日と終了日を入力しましたが、塗りつぶされないが、修正方法がわからない。

該当のソースコード

Sub ガントチャート描写() 'オートシェイプ一括消去 Call オートシェイプ一括消去 '予定日程バー追加 Call 予定日程バー追加 End Sub Private Sub オートシェイプ一括消去() Dim shp As Shape For Each shp In ActiveSheet.Shapes If shp.Type = msoFormControl Then 'マクロ実行ボタンである場合は何もしない Else shp.Delete 'マクロ実行ボタンでない図形は消去 End If Next shp End Sub Private Sub 予定日程バー追加() Dim ws1 As Worksheet Dim i As Long Dim st As Range, en As Range Dim dayEnd As Long, rowEnd As Long Dim rngStart As Range, rngEnd As Range Dim xStart As Single, yStart As Single, xEnd As Single, x As Single, y As Single Set ws1 = ActiveSheet With ws1 dayEnd = .Cells(4, Columns.Count).End(xlToLeft).Column 'カレンダー上の最終日付列の取得 rowEnd = .Cells(Rows.Count, 2).End(xlUp).Row 'タスク最終行の取得 On Error Resume Next For i = 2 To rowEnd '開始日と終了日の対応列を設定する Set st = .Cells(4, WorksheetFunction.Match(.Cells(i, 4), .Range(.Cells(4, 1), .Cells(4, dayEnd)), 0)) '開始日のカレンダー上での対応列を設定 Set en = .Cells(4, WorksheetFunction.Match(.Cells(i, 5), .Range(.Cells(4, 1), .Cells(4, dayEnd)), 0)) '終了日のカレンダー上での対応列を設定 '開始日と終了日の両方が見つかればバーを描写する Set rngStart = .Cells(i, st.Column) 'バーの描写開始セルの設定 Set rngEnd = .Cells(i, en.Column + 1) 'バーの描写終了セルの1日後を設定 xStart = rngStart.Left 'バーの描写開始位置のX座標 yStart = rngStart.Top 'バーの描写開始位置のY座標 xEnd = rngEnd.Left 'バーの描写終了位置のX座標 y = rngEnd.Height 'バーの高さの方向の幅 With .Shapes.AddShape(msoShapeRectangle, xStart, yStart, xEnd - xStart, y) 'オートシェイプでバーを追加 .Fill.ForeColor.RGB = RGB(160, 229, 133) 'バーの色を指定 .Line.ForeColor.RGB = RGB(255, 255, 255) '枠線の色を指定 End With Next i '次の行へ End With End Sub

試したこと

上記のコードで実行しています。
インターネットで見たサンプルを参考にしました。
現在の実行後の画面です。

イメージ説明

補足情報(FW/ツールのバージョンなど)

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

開始日と終了日が入力されている行のみ塗りつぶしを行いたい。

Forループの中の処理を開始日と終了日が入力されているときのみ処理するようにすればよいと思います。

VBA

1For i = 2 To rowEnd 2 If Not IsEmpty(.Cells(i, 4)) And Not IsEmpty(.Cells(i, 5) Then ' 追加 3 4~省略~ 5 6 End If ' 追加 7Next i '次の行へ 8

ボタンを押さなくても入力後エンターキーで実行できるようにする方法があるのかどうか。

ワークシートのChangeイベントで処理すればよいかと思います。
以下はD列E列を変更したときのみガントチャート描写関数を実行します。

VBA

1Private Sub Worksheet_Change(ByVal Target As Range) 2 If Not Application.Intersect(Target, Range("D:E")) Is Nothing Then 3 Call ガントチャート描写 4 End If 5End Sub

投稿2020/06/19 06:16

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

ベストアンサー

ExcelVBA

1Sub main() 2 With workshhets("試験予定") 3 予定塗りつぶし .Range("G5", .Range("G5").End(xlToRight)), .Range("C11:D22") 4 End With 5End Sub 6 7Sub 予定日塗りつぶし(ByRef rngDays As Range, ByRef rngDate As Range) 8 Dim c As Range 9 Dim rngTarget As Range 10 Dim ixStart As Long 11 Dim ixEnd As Long 12 13 14 For Each c In rngDate.Rows 15 ixStart = 0 16 ixEnd = 0 17 c.EntireRow.Interior.ColorIndex = xlNone 18 19 On Error Resume Next 20 With WorksheetFunction 21 ixStart = .Match(c.Cells(1), rngDays, 0) 22 ixEnd = .Match(c.Cells(2), rngDays, 0) 23 End With 24 On Error GoTo 0 25 26 If ixStart > 0 And ixEnd > 0 Then 27 Intersect(c.EntireRow, Application.Range(rngDays(ixStart), rngDays(ixEnd)).EntireColumn).Interior.Color = rgbPaleGreen 28 End If 29 Next 30End Sub

子プロシージャには変わるものを与えて、
再利用できるよういするといいかもです。
図形書くのめんどいので塗りつぶしにしました。

>ボタンを押さなくても入力後エンターキーで実行できるようにする方法があるのかどうか。
条件付き書式設定で塗りつぶせば、
マクロは要らず、入力に対して反応してくれますよ。
(マクロ無効で開かれても動くし。。。。)
(最近便利かと思ってマクロ仕込んで置いたらマクロ無効で開かれて不評を買ってしまった。愚痴)

投稿2020/06/19 08:42

mattuwan

総合スコア2136

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Mkasai

2020/06/22 05:25

図形より塗りつぶしが簡単ですね。 教えていただいたコードで試してみました。 アドバイスいただいたとおり、条件付きの書式設定で行ったほうが使いやすそうです。 ありがとうございました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問