สร้างกราฟอัตโนมัติใน Excel ด้วย VBA

ได้ช่วยเพื่อนเขียนโค้ด VBA ใน MS Excel เพื่อสร้างกราฟอัตโนมัติ ขอบันทึกเตือนความจำแบบสั้นๆเก็บไว้

ข้อมูลที่ต้องการสร้างกราฟนั้นเป็นชุดข้อมูลที่เหมือนกัน สามารถประยุกต์ใช้ให้เหมาะสมกับงานอื่นๆได้ แกน X เป็นปีที่เก็บข้อมูล เช่น ปี 1990-2017 ส่วนแกน Y เป็นชุดข้อมูลที่แตกต่างกันตามสนใจ อาจจะมีเป็นร้อยชุดข้อมูลเลยก็ได้ ถ้าจะมานั่งทำทีละกราฟ ทีละชุดข้อมูล และกราฟแต่ละอันยังมีรูปแบบเหมือนกัน จะค่อนข้างเสียเวลามาก โค้ด VBA จึงพอจะช่วยลดเวลาในการทำงานลงได้บ้าง

จะอธิบายตามโค้ดที่เขียนเลย

-เปิด VB editor ของ Excel ขึ้นมา แล้ว insert module ใน sheet ที่มีชุดข้อมูลที่ต้องการสร้างกราฟแล้ว จะจัดให้ข้อมูลวางแนว Row หรือ Column ก็ได้ แล้วค่อยไปกำหนดเองในโค้ด VBA

Option Explicit

Sub WRYChart()

'ประกาศชนิดของตัวแปร
Dim parameterNum As Integer
Dim co As ChartObject
Dim ct As Chart
Dim sc1 As SeriesCollection
Dim ser1 As Series
Dim LC As Long

'ให้สามารถสร้างกราฟตามชุดข้อมูลที่สนใจได้ จึงกำหนดหมายเลขกำกับแล้วอิงจากตัวเลขนั้นเพื่อสร้างกราฟ
parameterNum = InputBox("What parameter would you like to chart?")

'กำหนดหมายเลขของชุดข้อมูลไว้ เท่าไหร่ก็ได้ต้องครอบคลุมจำนวนชุดข้อมูลที่มี เช่น อันนี้มี 100 กราฟที่ต้องสร้าง
If parameterNum > 0 And parameterNum < 100 Then

'ตำแหน่ง(A10) cells ใน excel ที่อยากจะสร้างและวางกราฟลงไป ชื่อและขนาดของกราฟ ในที่นี้มีหลายกราฟ จึงเลือก column ท้ายสุดของข้อมูล และ(offset)เลื่อนลง ตามลำดับชุดข้อมูล 
Set co = Sheet3.ChartObjects.Add(Range("A10").Offset(parameterNum, 1).Left, Range("A10").Offset(parameterNum, 1).Top, 450, 200) 'Chart location
co.Name = "parameter number" & parameterNum & "Chart"

'ใส่รายละเอียดของกราฟที่อยากได้ ชื่อกราฟ รายละเอียดของแกน x,y
Set ct = co.Chart
With ct
.HasLegend = True
.HasTitle = True
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Jahr" 'กำหนดป้ายของแกน x โดยเขียนเองเป็นข้อความ
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Range("F3").Offset(parameterNum, 0).Value 'กำหนดป้ายของแกน y กำหนดให้เปลี่ยนตามข้อมูลใน cells ที่กำหนดไว้
.Axes(xlCategory).CategoryType = xlTimeScale 'ชนิดของข้อมูล
.Axes(xlCategory).BaseUnitIsAuto = True
.Axes(xlCategory).MajorUnit = 2 'กำหนดการแบ่งหน่วย
.Axes(xlCategory).TickLabels.Orientation = xlTickLabelOrientationUpward 'กำหนดการวางตัวป้าย

.ChartTitle.Text = Range("G3").Offset(parameterNum, 0).Value 'กำหนดชื่อ ให้เปลี่ยนตามข้อมูลใน cells (เริ่มที่ G3 เลื่อนตามหมายเลขเลือก) ที่กำหนดไว้
Set sc1 = .SeriesCollection 
Set ser1 = sc1.NewSeries

'รายละเอียดข้อมูลของกราฟที่จะสร้าง
With ser1
.Name = Range("G3").Offset(parameterNum, 0).Value 'ชื่อของข้อมูล
.XValues = Range(Range("G3").Offset(0, 1), Range("G3").End(xlToRight)) 'ชุดข้อมูลของแกน x (เลือกที่ตำแหน่ง G3 จนถึงตำแหน่งขาวสุด)
.Values = Range(Range("H3").Offset(parameterNum, 0), Range("L3").Offset(parameterNum, 0)) 'ชุดข้อมูลของแกน x (เลือกที่ตำแหน่ง H3 จนถึง L3)
.ChartType = xlXYScatterSmoothNoMarkers 'ชนิดของกราฟ
.Trendlines.Add(Type:=xlLinear, DisplayRSquared:=True).Select 'เพิ่มเติม การใส่ Trendline และค่า R Square ของเส้น

End With

End With

MsgBox ("That's Perfect!") 'แจ้งเตือนเมื่อกราฟสร้างเสร็จ

Else: MsgBox ("You must enter a parameter number between 1 and 100") 'แจ้งเตือนเมื่อใส่ตัวเลขผิดพลาด
End If

End Sub

ปล. กำหนดชุดข้อมูลของ x, y สามารถกำหนดในรูปแบบนี้ได้เช่นกัน

.Values = Range(Range("G3").Offset(parameterNum, 1), Range("G3").Offset(parameterNum, 1).End(xlToRight))

ข้อดีคือ สามารถเพิ่มชุดข้อมูลต่อไปได้เรื่อยๆ เพราะ End(xlToRight) จะวิ่งคลุมถึงตัวสุดท้ายของข้อมูล
ข้อเสียคือ ถ้าชุดข้อมูลไม่ต่อเนื่องมีขาดหรือหายไปในบาง cells มันจะไม่สามารถดึงข้อมูลทั้งหมดมาได้ ถ้าหากเป็นแบบนี้ต้องใช้การกำหนดระยะของขุดจ้อมูลเองดังตัวอย่างด้านบน

.Values = Range(Range("H3").Offset(parameterNum, 0), Range("AL3").Offset(parameterNum, 0))

ภาพประกอบอื่นๆ