VBA：自動畫圖(省時省力)

 前一篇文中，最後提到畫出圖，觀察整體趨勢，但小編實在太廢了，所以小編決定連畫圖也自動化。

VBA CODE：

	Sub INCOME_trend_BY_MONTH()
	Set OUT = Sheets("OUT")
	S1 = Sheets("OUT").Range("z2000").End(xlUp).Row
	S2 = Sheets("OUT").Range("Aa2000").End(xlUp).Row
	Tag = Sheets("OUT").Range("Z1:Z" & S1)
	Tag = WorksheetFunction.Transpose(Tag)
	DATAA = Sheets("OUT").Range("AA1:AA" & S2)
	DATAA = WorksheetFunction.Transpose(DATAA)
	FIRST = 找重複值的位置("OUT", DATAA(LBound(DATAA)), 0, 0, "B:B")
	LAST = 找重複值的位置("OUT", DATAA(UBound(DATAA)), 0, 0, "B:B")
	For I = LBound(Tag) - 1 To UBound(Tag) Step 1
	TEMP1 = Split(FIRST(I), "$")
	TEMP2 = Split(LAST(I), "$")
	If LAST(I) = "" Then
	Exit For
	End If
	Set rngSourceData = OUT.Range("E" & TEMP1(2) & ":" & "E" & TEMP2(2))
	Set rngXValues = OUT.Range("B" & TEMP1(2) & ":" & "B" & TEMP2(2))
	If I Mod 2 = 0 Then
	Set MYCHART = OUT.ChartObjects.Add(Left:=OUT.Columns("AB").Left, Width:=320, Top:=OUT.Rows(1 + (I) * 8).Top, Height:=240)
	OUT.Range("AB" & 2 + (I) * 8).Activate
	Else
	Set MYCHART = OUT.ChartObjects.Add(Left:=OUT.Columns("AI").Left, Width:=320, Top:=OUT.Rows(1 + (I - 1) * 8).Top, Height:=240)
	OUT.Range("AI" & 2 + (I - 1) * 8).Activate
	End If
	With MYCHART.Chart
	.ChartType = xlColumnClustered
	.SetSourceData Source:=rngSourceData, PlotBy:=xlColumns
	.HasTitle = True
	.ChartTitle.Text = Tag(I + 1)
	.SeriesCollection(1).XValues = rngXValues
	.ChartGroups(1).GapWidth = 10
	.Legend.Delete
	.PlotArea.Left = 1
	.PlotArea.Top = 0.527
	.PlotArea.Width = 300
	.PlotArea.Height = 292.869
	End With
	With MYCHART.Chart
	'.SeriesCollection(1).ChartType = xlColumnClustered
	With .SeriesCollection(1).Format.Fill
	.Visible = msoTrue
	.Visible = msoTrue
	'.InvertIfNegative = True
	.ForeColor.RGB = RGB(79, 129, 189)
	.Transparency = 0
	MYCHART.Chart.SeriesCollection(1).InvertIfNegative = True
	MYCHART.Chart.SeriesCollection(1).InvertColor = RGB(255, 0, 0)
	.Solid
	End With
	If CheckBox1 = True Then
	newHour = Hour(Now())
	newMinute = Minute(Now())
	newSecond = Second(Now()) + 1
	waitTime = TimeSerial(newHour, newMinute, newSecond)
	Application.Wait waitTime
	.Export Filename:=ThisWorkbook.Path & "\" & "X" & ".jpg", Filtername:="JPG"
	Call Line傳讀圖與訊息(ThisWorkbook.Path & "\" & "X" & ".JPG", Format(Now(), "HH:MM"))
	End If
	End With
	Next
	End Sub

view raw gistfile1.txt hosted with ❤ by GitHub

大概要點：

主要是透過關鍵字查詢相同關鍵字重複位置的作法來設定走勢圖資料來源。

每張圖自動控制位置。

每圖調整一下X軸的尺規資料與繪圖區圖型尺寸，然後設定"負值資料以補色顯示"尺規，然圖型具備兩種顏色。

最後為了有利於圖型的分享，加碼增加了一個LINE自動傳圖功能，讓我好分享資料 XD。

結果

有大神問資料長怎樣，補圖當參考