[發問] excel按日期作的工作表,如何將不同工作表中的日期欄位及良率欄位抓出作成折線圖

showhi

鍍膜.zip (7.29 KB)

下載次數: 4

2012-4-5 16:18

excel按日期作的工作表,如何將不同工作表中的日期欄位及良率欄位抓出作成折線圖

GBKEE

回復 1# showhi
請附上 檔案資料 才知如何作

register313

回復 1# showhi
第1次用VBA作圖表,請指正
結論:圖表物件太多,語法難記,大多用錄製的方式再作修改

1.自行新增"圖表"工作表

下載 (143.23 KB)

2012-4-5 22:20

2.執行 Sub XX()

1. Sub XX()
   
2. With Sheets("圖表")
   
3.   .[A1] = "日期"
   
4.   .[B1] = "良率"
   
5.   .[A2:B65536] = ""
   
6.   For Each Sh In Sheets
   
7.     If Sh.Name <> "圖表" Then
   
8.       .[A65536].End(xlUp)(2) = Sh.Name
   
9.       .[B65536].End(xlUp)(2) = 1 - Sh.[E26]
   
10.     End If
    
11.   Next
    
12. End With
    
13. Call ChartAdd
    
14. End Sub
    
15. Sub ChartAdd()
    
16. With Sheets("圖表")
    
17.   .ChartObjects.Delete                                 '刪除工作表內所有已存在之圖表物件
    
18.   R = .[A65536].End(xlUp).Row
    
19.   Set DataRng = .Range("A" & 1 & ":B" & R)             '指定資料範圍
    
20.   Set ValueRng = .Range("B" & 2 & ":B" & R)            '指定數值範圍
    
21.   Set XValueRng = .Range("A" & 2 & ":A" & R)           '指定類別座標軸範圍
    
22.   Set Rng = Range("D1:Z23")                            '建立新圖表並指定位置及大小
    
23.   Set mychart = .ChartObjects.Add(Rng(1).Left, Rng(1).Top, Rng.Width, Rng.Height)
    
24.   With mychart.Chart
    
25.     .ChartType = xlLine                                '指定圖表類型
    
26.     .SetSourceData Source:=ValueRng, PlotBy:=xlColumns '指定數值範圍與數列資料取自欄或列
    
27.     .ApplyDataLabels ShowValue:=True                   '設定顯示資料標籤
    
28.     .HasTitle = True                                   '設定顯示標題與其內容
    
29.     .ChartTitle.Text = "鍍膜"
    
30.     With .ChartTitle.Font                              '設定標題之格式
    
31.       .Size = 14
    
32.       .ColorIndex = 3
    
33.       .Name = "新細明體"
    
34.     End With
    
35.     With .ChartArea.Interior                           '設定圖表區之格式
    
36.       .ColorIndex = 8
    
37.       .PatternColorIndex = 1
    
38.       .Pattern = xlSolid
    
39.     End With
    
40.     With .PlotArea.Interior                            '設定繪圖區之格式
    
41.       .ColorIndex = 35
    
42.       .PatternColorIndex = 1
    
43.       .Pattern = xlSolid
    
44.     End With
    
45.     With .SeriesCollection(1).DataLabels               '設定數列1(良率)之格式
    
46.       .Font.Size = 10
    
47.       .Font.ColorIndex = 5
    
48.       .NumberFormatLocal = "0.0%"
    
49.       .Position = xlLabelPositionAbove
    
50.     End With
    
51.     With .SeriesCollection(1).Border
    
52.       .ColorIndex = 3
    
53.       .Weight = xlThick
    
54.        .LineStyle = xlContinuous
    
55.     End With
    
56.     With .SeriesCollection(1)
    
57.       .MarkerBackgroundColorIndex = 3
    
58.       .MarkerForegroundColorIndex = 2
    
59.       .MarkerStyle = xlCircle
    
60.       .Smooth = True
    
61.       .MarkerSize = 10
    
62.       .Shadow = False
    
63.     End With
    
64.     With .Axes(xlCategory).TickLabels                  '設定類別座標軸之格式
    
65.       .AutoScaleFont = False
    
66.       .Font.Name = "新細明體"
    
67.       .Font.Size = 12
    
68.       .Alignment = xlCenter
    
69.       .Offset = 50
    
70.       .Orientation = xlVertical
    
71.     End With
    
72.     With .Axes(xlValue)
    
73.       .TickLabels.AutoScaleFont = False
    
74.       .MinimumScale = 0.9
    
75.       .MaximumScale = 1
    
76.     End With
    
77.     With .Axes(xlValue).TickLabels
    
78.       .Font.Name = "新細明體"
    
79.       .Font.FontStyle = "標準"
    
80.       .Font.Size = 12
    
81.       .NumberFormatLocal = "0.00_ "
    
82.     End With
    
83.     .SeriesCollection(1).XValues = XValueRng
    
84.   End With
    
85. End With
    
86. End Sub

複製代碼

3.結果

下載 (208.67 KB)

2012-4-5 22:21