lamihsuen

回復 10# c_c_lai

c_c_lai大哥:你太強了謝謝你,這兩天一定要好好研究你的程式,如有不懂的地方還請大哥多多指導,首先. 要請教大哥如何設定程式前面序號

c_c_lai

回復 11# lamihsuen
妳指的"如何設定程式前面序號"我還不甚瞭解何意，舉個例子？
事後，我又加了 DataLabels 進去，內容如下：

1. (1)
   
2. Sub DrawStatistics(ct As Integer)
   
3.     Dim tbl As String
   
4. 
   
5.     StartKBarRow = 6
   
6.     With Worksheets(ct)
   
7.         tbl = .Name
   
8.         EndKBarRow = .Range("A1").CurrentRegion.Rows.Count
   
9.         Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))
   
10.         sPos(1) = CInt(Mid("205*090*090*100*132*096*132*090*173*090*314*090", (ct - 4) * 4 + 1, 3))    ' 圖標座標(列)
    
11.         sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3))    ' 圖標座標(欄)
    
12.         ' sPos(3) = CInt(Mid("720*720*720*720*720*720*720*720*720*720*720*720", (ct - 4) * 4 + 1, 3))  ' 圖表寬度
    
13.         ' 將 12 個統計圖表寬度 720 均改成 900，如此，於加上 DataLabels 後彼此間的距離會變為寬鬆，字距比較不會重疊再一起。
    
14.         sPos(3) = CInt(Mid("900*900*900*900*900*900*900*900*900*900*900*900", (ct - 4) * 4 + 1, 3))   
    
15.         sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3))    ' 圖表高度
    
16.         xText = UCase(tbl) & " : Z - Score"
    
17.         製圖程序 xlSh:=tbl
    
18.     End With
    
19. End Sub
    
20. 
    
21. (2)
    
22.         With .SeriesCollection(1)
    
23.             ' .
    
24.             ' .
    
25.             ' .
    
26.             With .Border
    
27.                 .Weight = xlHairline
    
28.                 .LineStyle = xlNone
    
29.             End With
    
30.         
    
31.             ' 加上 DataLabels 比較有看頭 (以下三行)，數據表達也較親和性。
    
32.             .HasDataLabels = True
    
33.             .DataLabels.NumberFormat = "##.####"    ' 取小數四位
    
34.             .DataLabels.Position = xlLabelPositionOutsideEnd

複製代碼

下載 (63.1 KB)

2012-7-20 20:36

c_c_lai

回復 11# lamihsuen
妳是指
Dim sPos(1 To 4)      
'  宣告一個公用一維陣列整數值變數，它在DrawStatistics()以及 製圖程序() 都會使用到。
Dim xText As String
'  宣告一個公用字串變數，它在DrawStatistics()以及 製圖程序() 都會使用到。
Dim Chart_Source As Variant
' 宣告一個公用 Variant 資料型態變數，用於紀錄圖表選取資料，它在DrawStatistics()以及 製圖程序() 都會使用到。
Dim StartKBarRow, EndKBarRow As Long   
' 用於紀錄選取資料的起始、截止列數 (動態紀錄資料錄之用)。它只有在DrawStatistics()內部使用，是應該放置於
' DrawStatistics() 內宣告的。當初開始撰寫時，原本考慮會跨涵式而將它置放於外部，程式改了改卻忘掉了。
嗎？

c_c_lai

回復 11# lamihsuen
圖標座標(列)改以動態處理

1. Sub DrawStatistics(ct As Integer)
   
2.     Dim tbl As String
   
3.     Dim totalRow As Long
   
4. 
   
5.     StartKBarRow = 6
   
6.     With Worksheets(ct)
   
7.         tbl = .Name
   
8.         EndKBarRow = .Range("A1").CurrentRegion.Rows.Count
   
9.         Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))
   
10.         
    
11.         ' sPos(1) = CInt(Mid("205*090*090*100*132*096*132*090*173*090*314*090", (ct - 4) * 4 + 1, 3)) ' 圖標座標(列)
    
12.         ' 為考量在實務運用上，每張表單內含資料內容之多寡不一，可能實際使用列數時有增減，故改以動態處理。
    
13.         sPos(1) = .UsedRange.Rows.Count
    
14.         While IsEmpty(.Cells(sPos(1), 3).Value) And sPos(1) > 6       ' 尚須再次過濾部分空白與非真實匯入資料的問題列
    
15.             sPos(1) = sPos(1) - 1
    
16.         Wend
    
17.         sPos(1) = sPos(1) + 5
    
18.         
    
19.         sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3))   ' 圖標座標(欄)
    
20.         sPos(3) = CInt(Mid("900*900*900*900*900*900*900*900*900*900*900*900", (ct - 4) * 4 + 1, 3))   ' 圖表寬度
    
21.         sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3))   ' 圖表高度
    
22.         xText = UCase(tbl) & " : Z - Score"
    
23.         製圖程序 xlSh:=tbl
    
24.     End With
    
25. End Sub

複製代碼

祝周末愉快！

c_c_lai

回復 11# lamihsuen
貼不上圖，我就用寫的：
請注意以下兩個不同語法之使用，其結果值(以 c 工作表單為例 ) 一個是 50，另一個是 200 (再加上5)。
(1)
        EndKBarRow = .Range("A1").CurrentRegion.Rows.Count
(2)
        ' sPos(1) = CInt(Mid("205*090*090*100*132*096*132*090*173*090*314*090", (ct - 4) * 4 + 1, 3)) ' 圖標座標(列)
        ' 為考量在實務運用上，每張表單內含資料內容之多寡不一，可能實際使用列數時有增減，故改以動態處理。
        sPos(1) = .UsedRange.Rows.Count
        While IsEmpty(.Cells(sPos(1), 3).Value) And sPos(1) > 6       ' 尚須再次過濾部分空白與非真實匯入資料的問題列
            sPos(1) = sPos(1) - 1
        Wend
        sPos(1) = sPos(1) + 5                                                                    ' 圖標座標(列)
CurrentRegion 與 UsedRange 的運用差異性。

lamihsuen

回復 10# c_c_lai
c_c_lai大哥你實在太強了我發了好長的時間都劃不好,你竟然一下子能把它劃出來,這兩天不要出去瘋子一定要好好留在家,研究你的程式,因為有好多都看不懂,到時還請你多多指導
另外要請問你序列號留在程式中就不能執行,必須一行一行刪除才能執行,你的是不是也一樣,如果是這樣就不要序列號是不是比較好?

lamihsuen

實驗室能力分析測試工作 (修改中3.1).rar (188.19 KB)

下載次數: 3

2012-7-21 12:27

回復 18# c_c_lai

c_c_lai大哥   我已經了解你的意思了.圖表區範圍會隨資料數列數而改變大小,我把程式作了一些改變再請大哥幫我看看,以下的問題
1,請大哥幫我注意水平軸類別是以"a"欄列數的值為依據,但現在是以數字為排列,例如"c"工作表的"a"欄列數的值(實驗室編號)是没有 3  的但圖表水平軸資料是有3
2 如果圖表的資料來源要改為執行最後一次outline的表格範圍時,以"c"工作表為例是"a"108到"a"152 跟"c"108 到"c"152 程式要如何改變,執行最後一次outline的表格列數我是以angin_sr作為起始值變數
    以"c"工作表為例angin_sr=109
   感謝大哥詳細解釋讓我受益良多,有你我不用怕會有白頭髮了

c_c_lai

回復 20# lamihsuen
以 "c" 工作表為例，共有四個區間，6-51,58-102,109-152,159-204，或
以 "ni" 工作表為例，共有三個區間，6-42,49-84,91-127，或
以 "mo" 工作表為例，共有四個區間，6-42,49-84,91-125,132-168。
在實務上妳是如何判定哪個工作表單之區間是屬哪一個區間？
(也就是12 個各自工作表單究竟應選擇哪一個區間作為圖表的 "選取資料"？)

我把妳的 Module3 稍稍整理了一下，請留意是那些變化了？

1. Option Explicit
   
2. 
   
3. Dim sPos(1 To 4)
   
4. Dim xText As String
   
5. Dim Chart_Source As Variant
   
6.    
   
7. Public Sub 再分析結果()
   
8.     Dim wr As Integer, an As Integer     ' 設定COPY工作表數目計數器
   
9.     Dim xlRow As Long
   
10.     Dim angin_sr As Integer              ' 下次起始 列 起點
    
11.     Dim sr As Integer                    ' 定義第一次起始列數
    
12.     Dim NGValue As Integer               ' 計算 "NG" 的家數
    
13.     Dim again_oi, again_oj As Integer    ' 上次表格列,行數計數器
    
14.     Dim again_ai, again_aj As Integer    ' 本次表格列,行數計數器
    
15.     Dim chart_end As Integer
    
16.     Dim z_sr As Integer
    
17.     Dim z_oi, z_oj As Integer            ' 第一次表格列,行數計數器
    
18.     Dim z_ai, z_aj As Integer            ' z-score表格列,行數計數器
    
19.     Dim mue_sr, mue_oi As Integer
    
20.             
    
21.     ' wr = 4  目前預設從 c 到 sn， 總共有 12 個工作表單
    
22.     For wr = 4 To Worksheets.Count
    
23.         sr = 6
    
24.         an = 1
    
25.         
    
26.         NGValue = 0
    
27.         
    
28.         With Worksheets(wr)
    
29.             ' 工作表從 4 迴圈開始執行再分析結果到工作表的最後
    
30.             Do Until .Cells((sr - 3), 12).Value = 0
    
31.                 ' outline 分析次數 + 1.並顯示在標題列 (B4) 儲存格
    
32.                 an = an + 1
    
33.                        
    
34.                 ' angin_sr=再次分析起始列為:第一次起始列數+第一次家數+6格空格
    
35.                 angin_sr = sr + (.Cells((sr - 3), 1).Value + 6)
    
36.                
    
37.                 ' 判別 上次分析有"NG"的去除,"OK"的COPY到本次表格
    
38.                 again_oi = sr
    
39.                 again_ai = angin_sr
    
40.                 ' 迴圈判別 "ok" 與 "ng" 從前次起始位置開始(sr)至前次表格最後(sr+前次表格"a"3)的值
    
41.                 For again_oi = again_oi To (sr + .Cells((sr - 3), 1).Value - 1)
    
42.                     ' 如果值為"ok"該列copy 到本次表格.如果值為"ng"則不處理
    
43.                     If .Cells(again_oi, 5).Value = "OK" Then
    
44.                         .Cells(again_ai, 1).Value = .Cells(again_oi, 1).Value
    
45.                         .Cells(again_ai, 2).Value = .Cells(again_oi, 2).Value
    
46.                         again_ai = again_ai + 1
    
47.                     End If
    
48.                 Next again_oi
    
49.                      
    
50.                 ' 將前次第三列標題列標題 copy 至本次表格第三列標題列標題
    
51.                 again_aj = 1
    
52.                 For again_oj = 1 To 12
    
53.                     .Cells(angin_sr - 4, again_aj).Value = .Cells(sr - 4, again_oj).Value
    
54.                     again_aj = again_aj + 1
    
55.                 Next again_oj
    
56.                           
    
57.                 ' 利用變數求出本次表格最後列數目的用於求出第三列公式的最後範圍
    
58.                 xlRow = .Range("B" & angin_sr).End(xlDown).Row
    
59.                     
    
60.                 chart_end = xlRow
    
61.                 ' 計算本次 "A3" 儲存格 NO.OF.RESULT值(分析值家數)從本次起始列至(angin_sr)至本次最後列數的數量
    
62.                 .Cells(angin_sr - 3, 1).Formula = "=COUNT(B" & angin_sr & ":B" & xlRow & ")"
    
63.                 ' 本次 "B3" 儲存格分析值中間值 (MEDIAN)
    
64.                 .Cells(angin_sr - 3, 2).Formula = "=MEDIAN(B" & angin_sr & ":B" & xlRow & ")"
    
65.                 ' 本次 C3 儲存格 IRQ 植
    
66.                 .Cells(angin_sr - 3, 3).Formula = "=(QUARTILE(B" & angin_sr & ":B" & xlRow & ",3) -QUARTILE(B" & angin_sr & ":B" & xlRow & ",1))*0.7413"
    
67.                         
    
68.                 ' 本次 "E3" 儲存格ROBUS CV值
    
69.                 .Cells(angin_sr - 3, 5).Formula = "=  C3 / B3 *100"
    
70.                 ' 本次 "F3" 儲存格分析值中最少值
    
71.                 .Cells(angin_sr - 3, 6).Formula = "=MIN(B" & angin_sr & ":B" & xlRow & ")"
    
72.                 ' 本次 "G3" 儲存格分析值中最大值
    
73.                 .Cells(angin_sr - 3, 7).Formula = "=MAX(B" & angin_sr & ":B" & xlRow & ")"
    
74.                 ' 本次 "H3" 儲存格RANGE值
    
75.                 .Cells(angin_sr - 3, 8).Formula = "=G3-F3"
    
76.                 ' 本次定義 "I3" 儲存格為 E178 值
    
77.                 .Cells(angin_sr - 3, 9).Value = E178(.Cells(angin_sr - 3, 1).Value)
    
78.                 ' 本次定義 "j3" 儲存格為分析值平均值
    
79.                 .Cells(angin_sr - 3, 10).Formula = "=AVERAGE(B" & angin_sr & ":B" & xlRow & ")"
    
80.                 ' 本次定義 "k3" 儲存格為stdv
    
81.                 .Cells(angin_sr - 3, 11).Formula = "=STDEV(B" & angin_sr & ":B" & xlRow & ")"
    
82.                 ' 本次 "NG" 家數 值
    
83.                 .Cells(angin_sr - 3, 12).Value = NGValue
    
84.                 ' 本次標題列 "執行第" 字串直接從前次儲存格位置 copy
    
85.                 .Cells(angin_sr - 2, 1).Value = .Cells(sr - 2, 1).Value
    
86.                 ' 本次標題列顯示第 an 次分析
    
87.                 .Cells(angin_sr - 2, 2).Value = an
    
88.                 ' 本次標題列 "ouline" 字串直接從前次儲存格位置 copy
    
89.                 .Cells(angin_sr - 2, 3).Value = .Cells(sr - 2, 3).Value
    
90.                 ' 本次定義實驗室編號標題列直接從前次儲存格位置 copy
    
91.                 .Cells(angin_sr - 1, 1).Value = .Cells(sr - 1, 1).Value
    
92.                 ' 本次定義實驗室分析值標題列直接從前次儲存格位置 copy
    
93.                 .Cells(angin_sr - 1, 2).Value = .Cells(sr - 1, 2).Value
    
94.                 ' 本次定義z-score值標題列直接從前次儲存格位置 copy
    
95.                 .Cells(angin_sr - 1, 3).Value = .Cells(sr - 1, 3).Value
    
96.                 ' 本次定義outline標題列直接從前次儲存格位置 copy
    
97.                 .Cells(angin_sr - 1, 4).Value = .Cells(sr - 1, 4).Value
    
98.                 ' 定義判定結果值標題列直接從前次儲存格位置 copy
    
99.                 .Cells(angin_sr - 1, 5).Value = .Cells(sr - 1, 5).Value
    
100.                 ' 本次 "C" 欄 Z-SCORE 值計算
     
101.                 .Range("C" & angin_sr & " :C" & xlRow).Formula = "=(b" & angin_sr & "-$B$" & angin_sr - 3 & ") /$C$" & angin_sr - 3
     
102.                 ' 本次 "D" 欄 OUTLINE 值計算
     
103.                 .Range("d" & angin_sr & " :d" & xlRow).Formula = "= (B" & angin_sr & " -$J$" & angin_sr - 3 & ")/$K$" & angin_sr - 3
     
104.                        
     
105.                 ' 本次 "E' 欄判別 OUTLINE,  true="ok"  FALSE="NG"
     
106.                 ' "NG"家數起始值 ,目的"將有"ng"家數記錄在"L3"欄位用於是否繼續判別 OUTLINE
     
107.                        
     
108.                 .Range("L" & angin_sr - 3).Value = 0
     
109.                           
     
110.                 ' 開始判別從本次起始列開始
     
111.                 ' again_ai = angin_sr
     
112.                              
     
113.                 ' For again_ai = again_ai To ((angin_sr) + .Range("A" & angin_sr - 3).Value - 1)
     
114.                 For again_ai = angin_sr To ((angin_sr) + .Range("A" & angin_sr - 3).Value - 1)
     
115.                     ' 比對 D6 是否 < E178 值 (I3) 欄
     
116.                     If .Range("D" & again_ai).Value < .Range("I" & angin_sr - 3).Value Then
     
117.                         ' 值 = TRUE 時 E 欄記錄 "OK"
     
118.                         .Range("E" & again_ai).Value = "OK"
     
119.                     Else
     
120.                         ' 值 = FLACE時E欄記錄 "NG"
     
121.                         .Range("E" & again_ai).Value = "NG"
     
122.                         ' 設 "NG" FONT.COLOR 為紅色
     
123.                         .Range("E" & again_ai).Font.Color = vbRed
     
124.                         ' "NG" 家數 + 1
     
125.                         .Range("L" & angin_sr - 3).Value = .Range("L" & angin_sr - 3).Value + 1
     
126.                     End If
     
127.                 Next again_ai
     
128.                                  
     
129.                 ' 如果還有 "NG" 值繼續執行 OUTLINE
     
130.                 ' 將本次表格列數值設定給上次表格列數目的將本次表格列數作為下次表格計算基礎
     
131.                 sr = angin_sr
     
132.             Loop
     
133.                
     
134.             ' ********此處為.Cells((sr - 3), 12).Value =0."NG" 家數=0 全部""可執 行Z-SCORE
     
135.             ' 定義z_sr為z_score起始表格列
     
136.             angin_sr = sr ' 將 sr 值回愎給 angin_sr 目的為把最後一次 outline "sr=angin_sr" 回愎回來
     
137.             sr = 6        ' 將sr回愎到第一次表格起始位置
     
138.                   
     
139.             ' z_sr = 執行 z-score 起始列為: 最後一次起始列數 + 最後分析家數 + 6 格空格
     
140.             z_sr = angin_sr + (.Cells((angin_sr - 3), 1).Value + 6)
     
141.                   
     
142.             ' 設定元素 z_score 標題列標題 (z_score 的第三列)
     
143.             .Cells((z_sr - 2), 1).Value = "執行"
     
144.             .Cells((z_sr - 2), 2).Value = .Name
     
145.             .Cells((z_sr - 2), 3).Value = "z_score"
     
146.                   
     
147.             ' 將第一次表格 "實驗室編號" (第一行號)與 "分析值" (第二行) copy 至 z_score 表格因為要全部 "實驗室編號" 與 "分析值"
     
148.                        
     
149.             z_oi = sr                      ' z_oi 定義為 第一次 起始格表格開始計數
     
150.             z_ai = z_sr                    ' z_ai 定義為 z_score 起始表格開始計數
     
151.                  
     
152.             For z_oi = z_oi To sr + .Cells((sr - 3), 1).Value
     
153.                 .Cells(z_ai, 1).Value = .Cells(z_oi, 1).Value
     
154.                 .Cells(z_ai, 2).Value = .Cells(z_oi, 2).Value
     
155.                 z_ai = z_ai + 1
     
156.             Next z_oi

複製代碼

c_c_lai

回復 17# lamihsuen

1.             ' 將最後一次第一列(公式)標題列標題與第二列公式值 copy 至 ZSCORE 表格第一列與第二列
   
2.             z_oi = angin_sr
   
3.             z_ai = z_sr
   
4.             z_aj = 1
   
5.             For z_oj = 1 To 12
   
6.                 .Cells(z_ai - 4, z_aj).Value = .Cells(z_oi - 4, z_oj).Value
   
7.                 .Cells(z_ai - 3, z_aj).Value = .Cells(z_oi - 3, z_oj).Value
   
8.                 z_aj = z_aj + 1
   
9.             Next z_oj
   
10.             ' 定義第四列表格標題列
    
11.             xlRow = .Range("B" & z_sr).End(xlDown).Row
    
12.             .Cells((z_sr - 1), 1).Value = .Cells((sr - 1), 1).Value
    
13.             .Cells((z_sr - 1), 2).Value = .Cells((sr - 1), 2).Value
    
14.             .Cells((z_sr - 1), 3).Value = .Cells((sr - 1), 3).Value
    
15.             .Cells((z_sr - 1), 4).Value = "判別結果"
    
16.             .Cells((z_sr - 1), 5).Value = "分析方法"
    
17.             .Cells((z_sr - 1), 6).Value = "使用儀器"
    
18.                                                          
    
19.             ' 本次 "C" 欄 Z-SCORE 值計算
    
20.             ' .Range("C" & z_sr & " :C" & xlRow).Formula = "=(b" & z_sr & "-$B$" & z_sr - 3 & ") /$C$" & z_sr - 3
    
21.             ' .Range("D" & z_sr & " :D" & xlRow).Formula = "=IF(C" & z_sr & ">=3,""異常"",IF( C" & z_sr & "<=2,""ok"",""有質疑""))"
    
22.          
    
23.             ' 2012/7/20 新增列
    
24.             ' 判別本次 "C" 欄 Z-SCORE 值如果是 outline 則 z 值顯示 "*"
    
25.             ' 設定 mue_sr, mue_oi 為 z 值欄位計數器
    
26.             mue_sr = z_sr
    
27.             mue_oi = angin_sr
    
28.             For mue_sr = mue_sr To xlRow
    
29.                 If .Cells(mue_sr, 1) = .Cells(mue_oi, 1) Then
    
30.                     .Cells(mue_sr, 3).Formula = "=(b" & mue_sr & "-$B$" & z_sr - 3 & ") /$C$" & z_sr - 3
    
31.                     If .Cells(mue_sr, 3).Value > 3 Or .Cells(mue_sr, 3).Value <= -3 Then
    
32.                         .Cells(mue_sr, 3).Font.Color = RGB(255, 0, 255)
    
33.                     End If
    
34.                     mue_oi = mue_oi + 1
    
35.                 Else
    
36.                     .Cells(mue_sr, 3).Value = "*"
    
37.                     .Cells(mue_sr, 3).Interior.Color = RGB(255, 0, 0)
    
38.                     .Cells(mue_sr, 3).HorizontalAlignment = xlHAlignCenter
    
39.                 End If
    
40.             Next mue_sr
    
41.             '  定義 z 值判別結果並顯示 (D) 欄,"(Z) 值 <= 2 為 "OK" 顯示綠色","2<(Z) 值 <3 為 "有質疑" 顯示黃色,(Z)值 >3 為 "異常" 顯示紅色
    
42.         End With
    
43.             
    
44.         '  繪製統計分析圖表
    
45.         Call DrawStatistics(wr)
    
46.     Next wr
    
47. End Sub
    
48. 
    
49. Sub DrawStatistics(ct As Integer)
    
50.     Dim tbl As String
    
51.     Dim totalRow As Long
    
52.     Dim StartKBarRow, EndKBarRow As Long
    
53. 
    
54.     StartKBarRow = 6
    
55.     With Worksheets(ct)
    
56.         tbl = .Name
    
57.         EndKBarRow = .Range("A1").CurrentRegion.Rows.Count
    
58.         Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))
    
59.         
    
60.         ' sPos(1) = CInt(Mid("205*090*090*100*132*096*132*090*173*090*314*090", (ct - 4) * 4 + 1, 3)) ' 圖標座標(列)
    
61.         ' 為考量在實務運用上，每張表單內含資料內容之多寡不一，可能實際使用列數時有增減，故改以動態處理。
    
62.         sPos(1) = .UsedRange.Rows.Count
    
63.         While IsEmpty(.Cells(sPos(1), 3).Value) And sPos(1) > 6       ' 尚須再次過濾部分空白與非真實匯入資料的問題列
    
64.             sPos(1) = sPos(1) - 1
    
65.         Wend
    
66.         sPos(1) = sPos(1) + 5
    
67.         
    
68.         sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3))   ' 圖標座標(欄)
    
69.         sPos(3) = CInt(Mid("900*900*900*900*900*900*900*900*900*900*900*900", (ct - 4) * 4 + 1, 3))   ' 圖表寬度
    
70.         sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3))   ' 圖表高度
    
71.         xText = UCase(tbl) & " : Z - Score"
    
72.         製圖程序 xlSh:=tbl
    
73.     End With
    
74. End Sub
    
75. 
    
76. Private Sub 製圖程序(xlSh As String)                                ' 全部重繪
    
77.     Dim Sh As Worksheet, xi As Integer
    
78.    
    
79.     Set Sh = Sheets(xlSh)
    
80.     Sh.ChartObjects.Delete
    
81. 
    
82.     With Sh.ChartObjects.Add(Sh.Cells(sPos(1), sPos(2)).Left, Sh.Cells(sPos(1), sPos(2)).Top, sPos(3), sPos(4)).Chart
    
83.         .ChartType = xlColumnClustered                          ' xlColumnStacked -> 堆疊直條圖
    
84.         .SetSourceData Source:=Chart_Source
    
85.         .HasLegend = 0                                          ' 圖表的圖例:  不可見
    
86.         .SeriesCollection(1).AxisGroup = 1
    
87.             
    
88.         With .Axes(xlCategory)                                  ' X座標軸
    
89.             .CategoryType = xlCategoryScale
    
90.             ' .TickLabels.NumberFormatLocal = "hh:mm"
    
91.             .MajorTickMark = xlNone
    
92.             .Border.Weight = xlHairline
    
93.             .Border.LineStyle = xlNone
    
94.             .TickLabelPosition = xlLow
    
95.             .TickLabels.Font.Size = 10
    
96.         End With
    
97.                   
    
98.             '*******************************************************************
    
99.                   
    
100.         With .SeriesCollection(1)
     
101.             .Shadow = False                                ' 圖表中的數列(1)
     
102.             .InvertIfNegative = True
     
103.             ' .InvertColor = RGB(255, 124, 128)                      ' 當表列數值為負值時，將其顯示之顏色更變成淺天藍色
     
104.             .InvertColor = RGB(32, 178, 208)                         ' 當表列數值為負值時，將其顯示之顏色更變成青藍色
     
105.         
     
106.             With .Format.Fill
     
107.                 .Visible = msoTrue
     
108.                 ' .ForeColor.RGB = RGB(149, 179, 215)                ' 當表列數值為正值時，顯示之顏色為橘紅色
     
109.                 .ForeColor.RGB = RGB(255, 69, 0)                     ' 當表列數值為正值時，顯示之顏色為粉紅色
     
110.                 .Transparency = 0
     
111.                 .Solid
     
112.             End With
     
113.         
     
114.             With .Border
     
115.                 .Weight = xlHairline
     
116.                 .LineStyle = xlNone
     
117.             End With
     
118.         
     
119.             .HasDataLabels = True
     
120.             .DataLabels.NumberFormat = "##.##"
     
121.             .DataLabels.Position = xlLabelPositionOutsideEnd
     
122.             ' With .Interior
     
123.             '     .ColorIndex = 5
     
124.             '     .PatternColorIndex = 42
     
125.             '     .Pattern = xlSolid
     
126.             ' End With
     
127.         End With
     
128.                   
     
129.         ' *******************************************************************
     
130.                      
     
131.         With .Axes(xlValue).TickLabels.Font                    ' Y座標軸上刻度的刻度標籤的字體
     
132.             .FontStyle = "標準"
     
133.             .Size = 10
     
134.         End With
     
135.                      
     
136.         With .Axes(xlValue)
     
137.             .MajorUnit = 2                                     ' 圖表左側數列之間距值設定
     
138.             ' .MaximumScale = 30
     
139.             ' .MinimumScale = -40
     
140.         End With
     
141.         
     
142.         .HasTitle = True                                       ' 圖表的標題   可見
     
143.               
     
144.         With .ChartTitle                                       ' 圖表的標題
     
145.             .Top = 1
     
146.             .Text = xText
     
147.             .Font.Size = 16
     
148.         End With
     
149. 
     
150.         With .PlotArea                                         ' 圖表的繪圖區
     
151.             .Top = 16
     
152.             .Left = 1
     
153.             .Width = sPos(3)
     
154.             .Height = sPos(4)
     
155.             .Interior.ColorIndex = xlNone
     
156.         End With
     
157.     End With
     
158. End Sub

複製代碼

lamihsuen

回復 18# c_c_lai


c_c_lai 大哥, 我要使用倒數第二個區間,
以"c"來說是109-152, 以"ni"是49-84, 而"mo"是91-125
另外7/20日新增的列是要取代下列程式因此下列程式我已經刪除了
19.            ' 本次 "C" 欄 Z-SCORE 值計算

20.            ' .Range("C" & z_sr & " :C" & xlRow).Formula = "=(b" & z_sr & "-$B$" & z_sr - 3 & ") /$C$" & z_sr - 3

21.            ' .Range("D" & z_sr & " :D" & xlRow).Formula = "=IF(C" & z_sr & ">=3,""異常"",IF( C" & z_sr & "<=2,""ok"",""有質疑""))"


另外我想加入水平軸標題與垂直軸標題 加入下列語法(水平軸標題"實驗室編號")垂直軸標題"z_score"


        With .Axes(xlCategory)                                  ' X座標軸

             .CategoryType = xlCategoryScale

             ' .TickLabels.NumberFormatLocal = "hh:mm"

            .MajorTickMark = xlNone

            .Border.Weight = xlHairline

             .Border.LineStyle = xlNone

             .TickLabelPosition = xlLow

             .TickLabels.Font.Size = 10
              .HasTitle = True                       **********  '這是我加入的  *********
              AxisTitle.Text = "實驗室編號"
            
         End With
這樣可以嗎?