实例需求:工作表中共有4组数据,第一组数据涵盖所有日期,其他3组均为断续数据。
现在需要创建如下图所示的线图,由于数据区域是非连续的,因此无法直接创建图表。
需要先将数据表按照日期对齐,如下图所示,才能创建图表。
Sub Demo()
Dim i As Long, j As Long, iCol As Long, ColCnt As Long
Dim arrData, arrData2, rngData As Range, allDateRng As Range
Dim arrRes, iR As Long, oSht As Worksheet, xRng As Range
Dim LastRow As Long, aRow, iMin As Long, iMax As Long
aRow = Array(2, 5, 8, 11)
Sheets(1).Copy After:=Sheets(Sheets.Count)
Set oSht = ActiveSheet
Set allDateRng = oSht.Range("A" & aRow(0)).CurrentRegion
arrData = allDateRng.Value
ColCnt = UBound(arrData, 2)
Set xRng = allDateRng.Resize(1, ColCnt - 1).Offset(, 1)
iMin = Application.Min(oSht.Rows(aRow(0)))
For i = 1 To UBound(aRow)
Set rngData = oSht.Range("A" & aRow(i)).CurrentRegion
arrData2 = rngData.Value
ReDim arrRes(1, 1 To ColCnt)
arrRes(0, 1) = arrData2(1, 1)
arrRes(1, 1) = arrData2(2, 1)
For j = 2 To UBound(arrData2, 2)
iCol = CLng(arrData2(1, j)) - iMin + 2
arrRes(0, iCol) = arrData2(1, j)
arrRes(1, iCol) = arrData2(2, j)
Next
rngData.Resize(, ColCnt).Value = arrRes
Next
Dim oShp As Shape, oCht As Chart, oSer As Series, serRng As Range
For i = 1 To UBound(aRow)
Set serRng = allDateRng.Rows(1).Offset(aRow(i) - aRow(0) + 1)
Set allDateRng = Application.Union(allDateRng, serRng)
Next
Set oShp = ActiveSheet.Shapes.AddChart2(332, xlLineMarkers)
oShp.Top = oSht.Range("A15").Top: oShp.Left = 0
Set oCht = oShp.Chart
oCht.SetSourceData allDateRng
End Sub
【代码解析】
第6行代码创建数组,其中每个元素代表一个图表数据的起始行号。在此示例中,数据间隔是规律化的,也可以使用循环获取数据区域。
第7行代码将数据表复制一份,并保存在当前工作簿中的最后位置。
第8行代码获取新创建的工作表对象。
第9行代码获取第一个数据区域。
第10行代码将数据区域的值加载到数组中。
第11行代码获取数据的列数。
第12行代码获取首行数据区域,注意此处不保护首列。
第13行代码获取首行数据区域中的最小日期。
第14~26行代码循环处理后续数据区域。
第15行代码获取数据区域。
第16行代码将数据加载到数组中。
第17行代码声明一个用于保存结果的数组。
第18~19行代码用于读取数据区域的首列两个单元格内容。
第20~24行代码循环处理后续数据。
第21行代码获取当前日期所在列的序号。
第22~23行代码用于将指定列两个单元格内容填充到对应的列,实现日期对齐。
第25行代码将整理后的数据区域写入工作表。
第28~31行代码循环遍历数据区域,将数据单元格区域组合为一个Range对象allDateRng。
第32行代码创建一个线图。
第33行代码调整图表的位置。
第34行代码获取图表对象。
第35行代码设置图表的数据源单元格区域。
运行示例代码,效果如下图所示。