Excel VBAの事例を演習として行う。題材は割り当て状況のグラフ化

はじめに
問題
解答
サイトご利用方法

はじめに

割り当て状況のグラフ化を行う。割り当て状況とは誰にどのくらい仕事が割り当てられているかを別シートに保存されている。

グラフ化とは、Excelのセルをひとつの目盛りとして縦棒グラフのように表現することである。

問題

左の白紙のグラフに、案件一覧という別シートから各人の割り当て状況をセルの数で右のグラフのように表現したもの

１）このグラフを作成せよ。ただし、案件一覧という別シートに入っているデータを使うこと。
２）このグラフから、セルをクリックして別の人に割り当てを変更できるように改良せよ。

解答

データ（案件一覧）

案件番号	顧客氏名	デザイナー	受注金額	納期	ステータス
A143	武田太一	木下	1,208,000	10月26日	9.完了
A121	千葉陸斗	岩崎	1,082,000	10月26日	9.完了
A229	山崎美月	岩崎	688,000	10月27日	9.完了
A362	高木千尋	山村	402,000	10月27日	9.完了
A180	小林愛美	岩崎	1,069,000	10月28日	9.完了
A168	田村一樹	武田	277,000	10月28日	9.完了
A262	宮崎明日香	木下	823,000	10月29日	9.完了
A111	菊地鈴	武田	1,213,000	10月26日	5.作業中
A172	木下優花	岩崎	1,175,000	10月26日	5.作業中
A286	藤田美玖	田村	532,000	10月26日	5.作業中
A301	鈴木雄太	岩崎	440,000	10月26日	5.作業中
A374	小野綾音	木下	252,000	10月26日	5.作業中
A208	柴田悠斗	山村	643,000	10月27日	5.作業中
A240	工藤太陽	岩崎	813,000	10月28日	5.作業中
A290	三浦奈々	岩崎	259,000	10月28日	5.作業中
A250	増田萌花	田村	855,000	10月29日	5.作業中
A160	岩崎拓磨	武田	281,000	10月29日	5.作業中
A391	長谷川啓太	木下	1,250,000	10月30日	5.作業中
A239	山口愛莉	武田	1,198,000	10月30日	5.作業中
A126	佐藤悠	田村	1,112,000	10月31日	5.作業中

１）のコード

ption Explicit
Option Base 1

Sub main()
Dim itemlist As Variant
Dim i As Integer, dispyear As Integer, dispmnth As Integer, receivmny As Integer
Dim myyear As Integer, mymnth As Integer, writtenrw As Integer, writtencol As Integer
Dim designer As String, stts As String

With Sheets("案件一覧")
.Range("A1").CurrentRegion.Sort key1:=.Range("F1"), order1:=xlDescending, Header:=xlYes
itemlist = .Range("A1").CurrentRegion

With Sheets("割り当て状況")

.Range("B3:F10").ClearContents
.Range("B3:F10").Interior.ColorIndex = 0

For i = 2 To UBound(itemlist)
designer = itemlist(i, 3)
receivmny = Int(itemlist(i, 4) / 1000)
myyear = Year(itemlist(i, 5))
mymnth = Month(itemlist(i, 5))
stts = itemlist(i, 6)

If .Range("B1").Value = myyear And .Range("C1").Value = mymnth Then
writtencol = WorksheetFunction.Match(designer, .Rows(11), 0)
writtenrw = .Cells(3, writtencol).End(xlDown).Row - 1

With .Cells(writtenrw, writtencol)
.Value = receivmny

If stts = "9.完了" Then
.Interior.Color = RGB(150, 150, 150)
Else
.Interior.Color = RGB(250, 200, 0)
End If
End With
End If
Next i
End With
End With
End Sub

1)の割り当てコマンドにはmainを割り当てる。

２）のコード

Option Explicit
Option Base 1

Sub main_change()
Dim itemlst As Variant
Dim i As Integer
Dim itemnum As String, designer As String

If Selection.Value > 0 Then
itemnum = Selection.Comment.Text
designer = InputBox("デザイナー名を入力してください", "割り当て変更")

If itemnum <> "" And designer <> "" Then
itemlst = Sheets("案件一覧").Range("A1").CurrentRegion

For i = 2 To UBound(itemlst)
If itemlst(i, 1) = itemnum Then
Sheets("案件一覧").Cells(i, 3).Value = designer
Exit For
End If
Next i

Call assign
End If
End If
End Sub

ーーーーーーーーーーーーーーーーーーーーーーー

Sub assign()
Dim itemlist As Variant
Dim i As Integer, dispyear As Integer, dispmnth As Integer, receivmny As Integer
Dim myyear As Integer, mymnth As Integer, writtenrw As Integer, writtencol As Integer
Dim designer As String, stts As String, itemnum As String

With Sheets("案件一覧")
.Range("A1").CurrentRegion.Sort key1:=.Range("F1"), order1:=xlDescending, Header:=xlYes
itemlist = .Range("A1").CurrentRegion

With Sheets("割り当て変更")

.Range("B3:F10").ClearContents
.Range("B3:F10").Interior.ColorIndex = 0
.Range("B3:F10").ClearComments

For i = 2 To UBound(itemlist)
itemnum = itemlist(i, 1)
designer = itemlist(i, 3)
receivmny = Int(itemlist(i, 4) / 1000)
myyear = Year(itemlist(i, 5))
mymnth = Month(itemlist(i, 5))
stts = itemlist(i, 6)

If .Range("B1").Value = myyear And .Range("C1").Value = mymnth Then
writtencol = WorksheetFunction.Match(designer, .Rows(11), 0)
writtenrw = .Cells(3, writtencol).End(xlDown).Row - 1

With .Cells(writtenrw, writtencol)
.Value = receivmny

If stts = "9.完了" Then
.Interior.Color = RGB(150, 150, 150)
Else
.Interior.Color = RGB(250, 200, 0)
End If
.AddComment itemnum
End With
End If
Next i
End With
End With
End Sub