120元红包感谢，有偿请坛友写折线图表代码

EXCELLMY

用代码做折线图.rar (54.78 KB, 下载次数: 314)

2020-1-20 09:42 上传

点击文件名下载附件

EXCELLMY

我的微信A15611155253 梧桐，qq 2512506251,EH

micch

附件是做好的嘛，没说明都不知道你要做什么

EXCELLMY

micch 发表于 2020-1-20 10:02
附件是做好的嘛，没说明都不知道你要做什么

用代码实现自动生成这些图表

micch

那你是希望实现4个表格分别4个折线图，还是一个表格可以四个折线图切换？你所设想的代码做图，是完全用数据源实现做图，还是代码生成做图的数据源

EXCELLMY

micch 发表于 2020-1-20 10:11
那你是希望实现4个表格分别4个折线图，还是一个表格可以四个折线图切换？你所设想的代码做图，是完全用数据 ...

方便的时候加一下微信或QQ吧

micch

1. Sub test()
   
2.     Set shts = Sheets("实际")
   
3.     Set shtm = Sheets("目标")
   
4.     arr = shts.UsedRange
   
5.     r = UBound(arr)
   
6. With Sheets("销售额监控")
   
7.     ks = .[l1].Value
   
8.     bt$ = Replace(.Name, "监控", "")
   
9.     n = 1
   
10.     Do
    
11.         n = n + 1
    
12.         If arr(n, 1) >= ks Then Exit Do
    
13.     Loop
    
14.     Set cht = .ChartObjects(1)
    
15.     With cht.Chart
    
16.         .ChartTitle.Text = "实际与计划" & bt & "对比图"
    
17.         .SeriesCollection(1).Values = shts.Range("F" & n & ":F" & r)
    
18.         .SeriesCollection(1).XValues = shts.Range("A" & n & ":A" & r)
    
19.         .SeriesCollection(1).Name = "实际"
    
20.         .SeriesCollection(2).Values = shtm.Range("E" & n & ":E" & r)
    
21.         .SeriesCollection(2).XValues = shts.Range("A" & n & ":A" & r)
    
22.         .SeriesCollection(2).Name = "目标"
    
23.     End With
    
24. End With
    
25. End Sub
    

复制代码

micch

1. Sub test2()
   
2.     Set shts = Sheets("实际")
   
3.     Set shtm = Sheets("目标")
   
4.     Dim cht As ChartObject, ws As Worksheet, ks As Date
   
5.     arr = shts.UsedRange
   
6.     r& = UBound(arr)
   
7.     ks = InputBox("请输入开始日期")
   
8.     If IsDate(ks) Then
   
9.         n& = 1
   
10.         Do While n < r
    
11.             n = n + 1
    
12.             If arr(n, 1) >= ks Then Exit Do
    
13.         Loop
    
14.         Application.ScreenUpdating = False
    
15.         Set ws = Sheets.Add
    
16.         With ws
    
17.             '.Name = "销售额"
    
18.             .[l1] = ks
    
19.             Set cht = ws.ChartObjects.Add(.[a5].Left, .[l5].Top, 720, 360)
    
20.             With cht.Chart
    
21.                 .ChartStyle = 233
    
22.                 .ChartType = xlLine
    
23.                 .SeriesCollection.NewSeries
    
24.                 .SeriesCollection(1).Values = shts.Range("F" & n & ":F" & r)
    
25.                 .SeriesCollection(1).XValues = shts.Range("A" & n & ":A" & r)
    
26.                 .SeriesCollection(1).Name = "实际"
    
27.                 .SeriesCollection(1).Format.Line.Weight = 1.5
    
28.                 .SeriesCollection.NewSeries
    
29.                 .SeriesCollection(2).Values = shtm.Range("E" & n & ":E" & r)
    
30.                 .SeriesCollection(2).XValues = shts.Range("A" & n & ":A" & r)
    
31.                 .SeriesCollection(2).Name = "目标"
    
32.                 .SeriesCollection(2).Format.Line.Weight = 1.5
    
33.                 .Axes(xlCategory).TickLabels.NumberFormatLocal = "m-d;@"
    
34.                 .HasTitle = True
    
35.                 .ChartTitle.Text = "实际与目标销售额对比图"
    
36.                 .ChartArea.Interior.Color = RGB(64, 64, 64)
    
37.             End With
    
38.         End With
    
39.         Application.ScreenUpdating = True
    
40.     Else
    
41.         MsgBox "请输入正确日期！"
    
42.     End If
    
43. End Sub

复制代码

重做一个

ranger丶亦

测试一下，学习了

EXCELLMY

micch 发表于 2020-1-20 15:00
重做一个

希望晚到的鲜花能表达我对老师深深的谢意