1234
返回列表 上一主題 發帖

請各位大大幫忙修改建立崁入圖表錯誤語法

lamihsuen

帖子
33 
主題
4 
精華
0 
積分
37 
點名
0  
作業系統
w7 
軟體版本
pro 
閱讀權限
10 
性別
女 
來自
台中 
註冊時間
2012-6-20 
最後登錄
2019-5-24 
11# 跳轉到 »
發表於 2012-7-20 20:21 | 只看該作者
回復 10# c_c_lai

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

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
12#
發表於 2012-7-20 20:36 | 只看該作者
回復 11# lamihsuen
妳指的"如何設定程式前面序號"我還不甚瞭解何意，舉個例子？
事後，我又加了 DataLabels 進去，內容如下：
  1. (1)
  2. Sub DrawStatistics(ct As Integer)
  3.     Dim tbl As String

  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

  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
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
13#
發表於 2012-7-20 21:13 | 只看該作者
回復 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() 內宣告的。當初開始撰寫時，原本考慮會跨涵式而將它置放於外部，程式改了改卻忘掉了。
嗎？

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
14#
發表於 2012-7-21 06:29 | 只看該作者
本帖最後由 c_c_lai 於 2012-7-21 06:42 編輯

回復 11# lamihsuen
圖標座標(列)改以動態處理
  1. Sub DrawStatistics(ct As Integer)
  2.     Dim tbl As String
  3.     Dim totalRow As Long

  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
複製代碼
祝周末愉快！

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
15#
發表於 2012-7-21 06:51 | 只看該作者
本帖最後由 c_c_lai 於 2012-7-21 07:31 編輯

回復 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 的運用差異性。

TOP

lamihsuen

帖子
33 
主題
4 
精華
0 
積分
37 
點名
0  
作業系統
w7 
軟體版本
pro 
閱讀權限
10 
性別
女 
來自
台中 
註冊時間
2012-6-20 
最後登錄
2019-5-24 
16#
發表於 2012-7-21 09:42 | 只看該作者
回復 10# c_c_lai
c_c_lai大哥你實在太強了我發了好長的時間都劃不好,你竟然一下子能把它劃出來,這兩天不要出去瘋子一定要好好留在家,研究你的程式,因為有好多都看不懂,到時還請你多多指導
另外要請問你序列號留在程式中就不能執行,必須一行一行刪除才能執行,你的是不是也一樣,如果是這樣就不要序列號是不是比較好?

TOP

lamihsuen

帖子
33 
主題
4 
精華
0 
積分
37 
點名
0  
作業系統
w7 
軟體版本
pro 
閱讀權限
10 
性別
女 
來自
台中 
註冊時間
2012-6-20 
最後登錄
2019-5-24 
17#
發表於 2012-7-21 12:26 | 只看該作者
本帖最後由 lamihsuen 於 2012-7-21 12:28 編輯

實驗室能力分析測試工作 (修改中3.1).rar (188.19 KB) 回復 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
   感謝大哥詳細解釋讓我受益良多,有你我不用怕會有白頭髮了

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
18#
發表於 2012-7-21 16:11 | 只看該作者
本帖最後由 c_c_lai 於 2012-7-21 17:50 編輯

回復 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

  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
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
19#
發表於 2012-7-21 17:51 | 只看該作者
回復 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

  49. Sub DrawStatistics(ct As Integer)
  50.     Dim tbl As String
  51.     Dim totalRow As Long
  52.     Dim StartKBarRow, EndKBarRow As Long

  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

  76. Private Sub 製圖程序(xlSh As String)                                ' 全部重繪
  77.     Dim Sh As Worksheet, xi As Integer
  78.    
  79.     Set Sh = Sheets(xlSh)
  80.     Sh.ChartObjects.Delete

  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

  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
複製代碼

TOP

lamihsuen

帖子
33 
主題
4 
精華
0 
積分
37 
點名
0  
作業系統
w7 
軟體版本
pro 
閱讀權限
10 
性別
女 
來自
台中 
註冊時間
2012-6-20 
最後登錄
2019-5-24 
20#
發表於 2012-7-21 17:52 | 只看該作者
本帖最後由 lamihsuen 於 2012-7-21 20:24 編輯

回復 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
這樣可以嗎?

TOP

        靜思自在 : 不要隨心所欲，要隨心教育自己。
1234
返回列表 上一主題