如何将数据批量添加到图标（深度-位移-时间曲线）

wjh9239

这种位移-深度-时间曲线,可以批量添加数据吗？请高手赐教

wjh9239

Sub 宏6()
'
' 宏6 宏
'

'
    ActiveSheet.ChartObjects("图表 8").Activate
    ActiveSheet.ChartObjects("图表 8").Activate
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    For i = 9 To 99
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(9).Name = "=H01!R1Ci"
    ActiveChart.FullSeriesCollection(9).XValues = "=H01!R2C8:R10Ci"
    ActiveChart.FullSeriesCollection(9).Values = "=H01!R2C1:R10C1"
    Next
End Sub
自己录制了宏，手动添加了for循环，但是无法运行，请各位老师指点一下

wjh9239

查阅了好多资料，借鉴摸索终于搞出来了，供同行参考，相互学习，共同提高
Sub autohzqx()
Dim cxChart As ChartObject, cxSHT As Worksheet, qi As Integer
Set cxSHT = activesheet'从当前活动工作表提取数据绘图
Set cxChart = cxSHT.ChartObjects.Add(200, 200, 600, 900) '插入图表，定义了位置和尺寸
cxChart.Chart.ChartType = xlXYScatterSmoothNoMarkers '定义图表类型为拆线散点图
For qi = 1 To 207 '循环添加系列
cxChart.Chart.SeriesCollection.NewSeries
cxChart.Chart.SeriesCollection(qi).Name = cxSHT.Cells(2, qi + 1) '系列名称
cxChart.Chart.SeriesCollection(qi).XValues = cxSHT.Range(Cells(4, qi + 1), Cells(60, qi + 1)) '系列横轴取值区间
cxChart.Chart.SeriesCollection(qi).Values = cxSHT.Range(Cells(4, 1), Cells(60, 1)) '系列纵轴取值区间
Next qi
cxChart.Chart.HasTitle = True
cxChart.Chart.ChartTitle.Text = "H01测孔朝沿河向深层位移曲线（2017年~2019年）" '图表名称
cxChart.Chart.Axes(xlValue).MajorUnit = 5 '纵轴主要刻度设为5
cxChart.Chart.Axes(xlValue).ReversePlotOrder = True '刻度逆序
cxChart.Chart.Axes(xlValue).MaximumScale = 43 '纵轴最大值
cxChart.Chart.Axes(xlValue).MinimumScale = 3 '纵轴最小值
cxChart.Chart.Axes(xlValue).TickLabelPosition = xlLow '标签设最低
cxChart.Chart.Axes(xlCategory).MaximumScale = 20 '横轴最大值
cxChart.Chart.Axes(xlCategory).MinimumScale = -20 '横轴最小值
With cxChart.Chart.Axes(xlValue)
        .HasTitle = True
        .AxisTitle.Caption = "深度(m)"
    End With
    With cxChart.Chart.Axes(xlCategory)
        .HasTitle = True
        .AxisTitle.Caption = "位移(mm)"
    End With
End Sub

联谊会

学习了，谢谢分享！