求助各位高手

SylviaW

想请问一下各位大侠，我想用VBA画折线图，在Return中画出每个银行收益率和时间的折线图，就像我画出来的那个一样。在Risk里面每个银行时间、市盈率和市净率画在一张折线图上，并按照银行命名。由于列是不固定的，所以想试一下循环语句，能按一下按钮就全部画出来那种，不好意思说已经做了好几天了，希望各位大侠赐教，不胜感激。

ivccav

你自己的图表太难看了，我没有完全按你的图表做。
（已按你的表格规律自动绘图，请勿随便更改表格式）
图aaa中，你的原图是下边那个，日期挡住线了，我就做成上边那个样式。



图bbb你没有提供原图，我就按我的思路设计了。

1. Sub AddNewCharts()
   
2.     Dim ch As ChartObject, ws As Worksheet
   
3.     Dim lastrow&, lastcol&
   
4.     Application.ScreenUpdating = False
   
5.     Set ws = Worksheets("Return")
   
6.     If ws.ChartObjects.Count > 0 Then ws.ChartObjects.Delete
   
7.     lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
   
8.     lastcol = ws.Cells(2, Columns.Count).End(xlToLeft).Column
   
9.         For i = 6 To lastcol Step 5
   
10.             Set ch = ws.ChartObjects.Add(ws.Cells(5, i - 4).Left, ws.Cells(5, 1).Top, 360, 215)
    
11.             ch.Name = ws.Cells(1, i - 4)
    
12.             With ch.Chart
    
13.                 .ChartType = xlLineMarkers
    
14.                 .SeriesCollection.NewSeries
    
15.                 .SeriesCollection(1).Values = ws.Range(ws.Cells(3, i), ws.Cells(lastrow, i))
    
16.                 .SeriesCollection(1).XValues = ws.Range(ws.Cells(3, 1), ws.Cells(lastrow, 1))
    
17.             End With
    
18.             With ch.Chart.Axes(xlValue, xlPrimary)
    
19.                 .CrossesAt = .MinimumScale
    
20.                 .TickLabels.Font.Size = 8
    
21.                 .MajorGridlines.Border.ColorIndex = 20
    
22.             End With
    
23.             With ch.Chart.Axes(xlCategory).TickLabels
    
24.                 .Font.Size = 8
    
25.                 .NumberFormatLocal = "yyyy/m/d"
    
26.             End With
    
27.             With ch.Chart
    
28.                 .HasTitle = True
    
29.                 .ChartTitle.Text = ch.Name
    
30.                 .ChartTitle.Font.Size = 18
    
31.                 .ChartTitle.Left = 137
    
32.                 .ChartTitle.Top = 2
    
33.                 .Legend.Delete
    
34.                 .PlotArea.Width = 347
    
35.                 .PlotArea.Left = 0
    
36.                 .PlotArea.Top = 20
    
37.                 .PlotArea.Height = 181
    
38.             End With
    
39.         Next
    
40.     Application.ScreenUpdating = True
    
41.     MsgBox "绘图完毕"
    
42. End Sub
    
43. 
    
44. 
    
45. Sub AddNewCharts2()
    
46.     Dim ch As ChartObject, ws As Worksheet
    
47.     Dim lastrow&, lastcol&
    
48.     Application.ScreenUpdating = False
    
49.     Set ws = Worksheets("Risk")
    
50.     If ws.ChartObjects.Count > 0 Then ws.ChartObjects.Delete
    
51.     lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
52.     lastcol = ws.Cells(2, Columns.Count).End(xlToLeft).Column
    
53.         For i = 2 To lastcol Step 5
    
54.             Set ch = ws.ChartObjects.Add(ws.Cells(5, i).Left, ws.Cells(5, 1).Top, 360, 215)
    
55.             ch.Name = ws.Cells(1, i)
    
56.             With ch.Chart
    
57.                 .ChartType = xlLineMarkers
    
58.                 .SeriesCollection.NewSeries
    
59.                 .SeriesCollection(1).Values = ws.Range(ws.Cells(3, i), ws.Cells(lastrow, i))
    
60.                 .SeriesCollection(1).XValues = ws.Range(ws.Cells(3, 1), ws.Cells(lastrow, 1))
    
61.                 .SeriesCollection(1).Name = "市盈率"
    
62.                 .SeriesCollection(1).AxisGroup = 1
    
63.                 .SeriesCollection.NewSeries
    
64.                 .SeriesCollection(2).Values = ws.Range(ws.Cells(3, i + 1), ws.Cells(lastrow, i + 1))
    
65.                 .SeriesCollection(2).XValues = ws.Range(ws.Cells(3, 1), ws.Cells(lastrow, 1))
    
66.                 .SeriesCollection(2).Name = "市净率"
    
67.                 .SeriesCollection(2).AxisGroup = 2
    
68.             End With
    
69.             With ch.Chart.Axes(xlValue, xlPrimary)
    
70.                 .CrossesAt = .MinimumScale
    
71.                 .TickLabels.Font.Size = 8
    
72.                 .MajorGridlines.Border.ColorIndex = 20
    
73.             End With
    
74.             With ch.Chart.Axes(xlValue, xlSecondary)
    
75.                 .CrossesAt = .MinimumScale
    
76.                 .TickLabels.Font.Size = 8
    
77.             End With
    
78.             With ch.Chart.Axes(xlCategory).TickLabels
    
79.                 .Font.Size = 8
    
80.                 .NumberFormatLocal = "yyyy/m/d"
    
81.             End With
    
82.             With ch.Chart
    
83.                 .HasTitle = True
    
84.                 .ChartTitle.Text = ch.Name
    
85.                 .ChartTitle.Font.Size = 18
    
86.                 .ChartTitle.Left = 137
    
87.                 .ChartTitle.Top = 2
    
88.                 .PlotArea.Width = 347
    
89.                 .PlotArea.Left = 0
    
90.                 .PlotArea.Top = 20
    
91.                 .PlotArea.Height = 181
    
92.             End With
    
93.         Next
    
94.     Application.ScreenUpdating = True
    
95.     MsgBox "绘图完毕"
    
96. End Sub
    

复制代码

副本Xl0000014.zip (178.23 KB, 下载次数: 3)

2018-6-2 22:13 上传

点击文件名下载附件

扑腾

ivccav 发表于 2018-6-2 22:15
你自己的图表太难看了，我没有完全按你的图表做。
（已按你的表格规律自动绘图，请勿随便更改表格式）
...

觉得好感人，，，虽然你帮的不是我，但我还是要说：辛苦了！

SylviaW

ivccav 发表于 2018-6-2 22:15
你自己的图表太难看了，我没有完全按你的图表做。
（已按你的表格规律自动绘图，请勿随便更改表格式）
...

谢谢您，非常非常感谢，学习了！

SylviaW

ivccav 发表于 2018-6-2 22:15
你自己的图表太难看了，我没有完全按你的图表做。
（已按你的表格规律自动绘图，请勿随便更改表格式）
...

万分感谢，谢谢您，学习了！

SylviaW

ivccav 发表于 2018-6-2 22:15
你自己的图表太难看了，我没有完全按你的图表做。
（已按你的表格规律自动绘图，请勿随便更改表格式）
...

谢谢您，万分感谢，学习啦！为什么回复总是显示不出来