麻辣家族討論版版 - Powered by Discuz! Board

標題: 請各位大大幫忙修改建立崁入圖表錯誤語法 [打印本頁]

作者: lamihsuen 時間: 2012-7-15 21:12 標題: 請各位大大幫忙修改建立崁入圖表錯誤語法

請各位大大幫忙我想在Worksheets(wr)工作表中繪製圖表(建立崁入圖表)請問正確語法為何

如果下列變數定義如下數值
WR=4
z_sr =120
lRow= 150
chart_sr    =156
chart_end=166
'設定要崁入圖表的位置
Dim GR As Range
Set GR = Worksheets(wr).Range("A" & chart_sr & " :I" & chart_end)'
With Worksheets(wr).ChartObjects.Add(GR.Left, GR.Top, GR.Width, GR.Height)
'設定工作表名稱+"值"為圖表名稱
            Worksheets(wr).ChartObjects.name= Worksheets(wr).name&"值"
' 設定資料範圍為儲存格 Worksheets(wr). RANRE ("A" & z_sr & " :C" & xlRow)
      Worksheets(wr).ChartObjects.SetSourceData.RANRE ("A" & z_sr & " :C" & xlRow)
請問設定圖表名稱.和設定圖表的資料範圍正確的語法為何?

作者: c_c_lai 時間: 2012-7-16 10:02

回復 1# lamihsuen
貼上 GBKEE 指導前輩曾經給我的範例，堤供妳參考，希望對妳會有實質的幫助。
又、妳打錯字了 .RANRE -> .RANGE。 (算粗心吧！:o )

Private Sub 製圖()
Dim xR As Range, Xi As Integer, i As Integer, 圖色()
圖色 = Array(4, 6, 8, 10)
ActiveSheet.ChartObjects.Delete '刪除全部圖表
Set xR = Range("F1") '利用xR的位置設下圖表的位置
'加入新圖表須指定 1右邊位置, 2高度位置, 3圖表的Width, 4圖表的Height
With ChartObjects.Add(xR.Left, xR.Top, xR.Resize(, 10).Width, xR.Resize(10).Height).Chart
.ChartType = 51 ' xlLineMarkers '折線圖 '圖表式樣
With ActiveSheet.Range("A2").CurrentRegion
Set xR = Union(.Columns(1), .Columns(3), .Columns(5))
'資料範圍的 1,3,5 欄為圖表資料 :第1欄為x軸的數值
End With
.SetSourceData Source:=xR, PlotBy:=xlColumns
'圖表資料來源 : xR 資料式樣: 欄
.HasTitle = True '顯示圖表標題
.ChartTitle.Characters.Text = ActiveSheet.Name 'HasTitle = False 會有錯誤
.HasAxis(xlCategory, xlPrimary) = False '不顯示 X軸座標
'HasLegend 圖例
.HasLegend = False ' 取消顯示圖例
' .Legend.Position = xlTop '顯示圖例位置
' .Axes(xlCategory).TickLabels.NumberFormatLocal = "m/d;@" ' Axes(xlCategory) X座標軸
' ** 上二式須顯示圖例 -> .HasLegend = True
'.SeriesCollection(1).AxisGroup = 2 '新增 Y座標軸副座標軸
' .SeriesCollection(3)).Delete '刪除第3數列資料
With .Axes(xlValue) 'y軸格線
.HasMajorGridlines = 0 '取消主格線
.HasMinorGridlines = 0 '取消副格線
End With
'以下一些程式碼你可用錄製得知
With .ChartArea '圖表的圖表區
.Border.Weight = 1
.Border.LineStyle = -1
.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=3, Degree:=0.231372549019608
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 圖色(0)
End With
With .PlotArea '圖表的繪圖區
.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, _
Degree:=0.231372549019608
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 圖色(0)
With .Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With
For i = 1 To .SeriesCollection.Count
With .SeriesCollection(i) '數列
' .XValues = "" '<-為x軸的數值可在此取消
With .Border
.ColorIndex = 圖色(i)
.Weight = xlMedium
.LineStyle = xlContinuous
End With
'以下屬性只適合折線圖
' .MarkerBackgroundColorIndex = xlAutomatic
'.MarkerForegroundColorIndex = xlAutomatic
'.MarkerStyle = xlNone
'.Smooth = False
'.MarkerSize = 7
'.Shadow = False
End With
Next
End With
End Sub

複製代碼

作者: lamihsuen 時間: 2012-7-16 18:30

c_c_lai 大大謝謝幫忙這程式對我來說還太難了.我只想用直線圖,在每一工作表最後儲存格Worksheets(wr).Range("A" & chart_sr & " :I" & chart_end)的範圍加入圖表,資料來源為同表格的
Worksheets(wr). RANRE ("A" & z_sr & " :C" & xlRow),因為有10個工作表都要加入且每一個工作表最後空儲存格不一定所以列數用變數方式,工作表Worksheets(wr). wr也是變數.因為我想用迴圈方式讓所有工作表一次完成,
ps RANRE -> .RANGE 感謝提醒,確實粗心了

作者: lamihsuen 時間: 2012-7-17 23:14

c_c_lai 大大回讀你的帖了看了GBKEE前輩的回覆其中下列的程式
03. With ActiveSheet.ChartObjects(oShape.Name).Chart
改以用下列
With WORKSHEETS(WR).ChartObjects(1).Chart
就可以執行程式原來是物件的語法錯誤
08. End With
感謝兩位大哥的協助

作者: c_c_lai 時間: 2012-7-18 07:28

回復 4# lamihsuen
沒錯，妳也可以應用下列 Set Sh = Sheets(xlSh) 以及 With Sh.ChartObjects.Add 的方式來處理：

Private Sub 製圖程序(xlSh As String) ' 重繪
Dim Sh As Worksheet, xi As Integer
Set Sh = Sheets(xlSh)
Sh.ChartObjects.Delete
陣列設定 ShName:=Sh.Name
For xi = 1 To IIf(Sh.Name = "Omega", 5, 6)
With Sh.ChartObjects.Add(Sh.Cells(xRow(xi), yCol(xi)).Left, Sh.Cells(xRow(xi), yCol(xi)).Top, cWidth(xi), cHeight(xi)).Chart
.ChartType = IIf(xi >= 5, xlLine, xlColumnStacked) ' xlLine-> 折線圖 ' xlColumnStacke-> 堆疊直條圖
.SetSourceData Source:=Chart_Source(xi)
.HasLegend = 0 ' 圖表的圖例: 不可見
.SeriesCollection(1).AxisGroup = IIf(xi >= 5, 2, 1)
If (xi = 5) Then
.SeriesCollection(4).ChartType = xlColumnClustered ' 堆疊直條圖
ElseIf (xi = 6) Then
.SeriesCollection(2).ChartType = xlColumnClustered ' 堆疊直條圖
End If
With .Axes(xlCategory) ' X座標軸
.CategoryType = xlCategoryScale
.TickLabels.NumberFormatLocal = "hh:mm"
.MajorTickMark = xlNone
.Border.Weight = xlHairline
.Border.LineStyle = xlNone
.TickLabelPosition = xlLow
.TickLabels.Font.Size = 10
End With
'*******************************************************************
' .
' .
' .
End With
Next xi
End Sub

複製代碼

我再附上我實務應用上的真實圖表提供妳參考。無論是何種表單圖形，其設計理念幾乎是雷同的。
[attach]11707[/attach]
[attach]11708[/attach]

作者: lamihsuen 時間: 2012-7-18 22:19

c_c_lai 大哥請問水平軸類別目前是在繪圖區內顯示我想跟你一樣顯示在繪圖區外下方如同你上方圖表的時間顯示一樣,因我的圖表資料數列有+值也有-值因此我的目前是顯示在中間0的下方請問語法要如何表達.才能跟一樣顯示在繪圖區外下方謝謝指導

作者: c_c_lai 時間: 2012-7-19 07:16

回復 6# lamihsuen
請附上你實際的檔案，我來看看你是如何設定。
P.S. 妳沒按 "回復" 鈕回復，如果我沒有留意到的話，是不知道有回復件的。

作者: lamihsuen 時間: 2012-7-19 19:07

回復 7# c_c_lai
c-c-lai 大哥我上傳了檔案,但我不會把檔名貼到帖子內,不知你是否可從附件叫出,

[attach]11763[/attach]

作者: c_c_lai 時間: 2012-7-20 16:43

回復 8# lamihsuen
請將原本 Module3 內的程式碼全部更換成以下之程式碼

' *********************************************************************
' Module3 (請將原本 Module3 內的程式碼全部更換成以下之程式碼)
' *********************************************************************
Option Explicit
Dim sPos(1 To 4)
Dim xText As String
Dim Chart_Source As Variant
Dim StartKBarRow, EndKBarRow As Long
Public Sub 再分析結果()
Dim wr As Integer, an As Integer ' 設定COPY工作表數目計數器
Dim xlRow As Long
' wr = 4 目前預設從 c 到 sn，總共有 12 個工作表單
For wr = 4 To Worksheets.Count
' 下次起始列起點
Dim angin_sr As Integer
Dim sr As Integer ' 定義第一次起始列數
sr = 6
an = 1
' 計算"NG"的家數
Dim NGVALUE As Integer
NGVALUE = 0
' 工作表從4 迴圈開始執行再分析結果到工作表的最後
Do Until Worksheets(wr).Cells((sr - 3), 12).Value = 0
' outline 分析次數+1.並顯示在標題列(B4)儲存格
an = an + 1
' angin_sr=再次分析起始列為:第一次起始列數+第一次家數+6格空格
angin_sr = sr + (Worksheets(wr).Cells((sr - 3), 1).Value + 6)
' 判別上次分析有"NG"的去除,"OK"的COPY到本次表格
Dim again_oi, again_oj As Integer ' 上次表格列,行數計數器
Dim again_ai, again_aj As Integer ' 本次表格列,行數計數器
again_oi = sr
again_ai = angin_sr
' 迴圈判別"ok"與"ng"從前次起始位置開始(sr)至前次表格最後(sr+前次表格"a"3的值
For again_oi = again_oi To sr + Worksheets(wr).Cells((sr - 3), 1).Value
' 如果值為"ok"該列copy 到本次表格.如果值為"ng"則不處理
If Worksheets(wr).Cells(again_oi, 5).Value = "OK" Then
With Worksheets(wr)
.Cells(again_ai, 1).Value = .Cells(again_oi, 1).Value
.Cells(again_ai, 2).Value = .Cells(again_oi, 2).Value
End With
again_ai = again_ai + 1
End If
Next again_oi
' 將前次第三列標題列標題copy 至本次表格第三列標題列標題
again_aj = 1
For again_oj = 1 To 12
Worksheets(wr).Cells(angin_sr - 4, again_aj).Value = Worksheets(wr).Cells(sr - 4, again_oj).Value
again_aj = again_aj + 1
Next again_oj
' 利用變數求出本次表格最後列數目的用於求出第三列公式的最後範圍
xlRow = Worksheets(wr).Range("B" & angin_sr).End(xlDown).Row
With Worksheets(wr)
' 計算本次"A3"儲存格 NO.OF.RESULT值(分析值家數)從本次起始列至(angin_sr)至本次最後列數的數量
.Cells(angin_sr - 3, 1).Formula = "=COUNT(B" & angin_sr & ":B" & xlRow & ")"
' 本次"B3"儲存格分析值中間值(MEDIAN)
.Cells(angin_sr - 3, 2).Formula = "=MEDIAN(B" & angin_sr & ":B" & xlRow & ")"
' 本次C3儲存格IRQ植
.Cells(angin_sr - 3, 3).Formula = "=(QUARTILE(B" & angin_sr & ":B" & xlRow & ",3) -QUARTILE(B" & angin_sr & ":B" & xlRow & ",1))*0.7413"
' 本次"E3"儲存格ROBUS CV值
.Cells(angin_sr - 3, 5).Formula = "= C3 / B3 *100"
' 本次"F3"儲存格分析值中最少值
.Cells(angin_sr - 3, 6).Formula = "=MIN(B" & angin_sr & ":B" & xlRow & ")"
' 本次"G3"儲存格分析值中最大值
.Cells(angin_sr - 3, 7).Formula = "=MAX(B" & angin_sr & ":B" & xlRow & ")"
' 本次"H3"儲存格RANGE值
.Cells(angin_sr - 3, 8).Formula = "=G3-F3"
' 本次定義"I3"儲存格為E178值
.Cells(angin_sr - 3, 9).Value = E178(.Cells(angin_sr - 3, 1).Value)
' 本次定義"j3"儲存格為分析值平均值
.Cells(angin_sr - 3, 10).Formula = "=AVERAGE(B" & angin_sr & ":B" & xlRow & ")"
' 本次定義"k3"儲存格為stdv
.Cells(angin_sr - 3, 11).Formula = "=STDEV(B" & angin_sr & ":B" & xlRow & ")"
' 本次"NG"家數值
.Cells(angin_sr - 3, 12).Value = NGVALUE
' 本次標題列"執行第"字串直接從前次儲存格位置copy
.Cells(angin_sr - 2, 1).Value = .Cells(sr - 2, 1).Value
' 本次標題列顯示第an次分析
.Cells(angin_sr - 2, 2).Value = an
' 本次標題列"ouline"字串直接從前次儲存格位置copy
.Cells(angin_sr - 2, 3).Value = .Cells(sr - 2, 3).Value
' 本次定義實驗室編號標題列直接從前次儲存格位置copy
.Cells(angin_sr - 1, 1).Value = .Cells(sr - 1, 1).Value
' 本次定義實驗室分析值標題列直接從前次儲存格位置copy
.Cells(angin_sr - 1, 2).Value = .Cells(sr - 1, 2).Value
' 本次定義z-score值標題列直接從前次儲存格位置copy
.Cells(angin_sr - 1, 3).Value = .Cells(sr - 1, 3).Value
' 本次定義outline標題列直接從前次儲存格位置copy
.Cells(angin_sr - 1, 4).Value = .Cells(sr - 1, 4).Value
' 定義判定結果值標題列直接從前次儲存格位置copy
.Cells(angin_sr - 1, 5).Value = .Cells(sr - 1, 5).Value
' 本次"C"欄 Z-SCORE 值計算
.Range("C" & angin_sr & " :C" & xlRow).Formula = "=(b" & angin_sr & "-$B$" & angin_sr - 3 & ") /$C$" & angin_sr - 3
' 本次 "D"欄OUTLINE值計算
.Range("d" & angin_sr & " :d" & xlRow).Formula = "= (B" & angin_sr & " -$J$" & angin_sr - 3 & ")/$K$" & angin_sr - 3
End With
' 本次"E' 欄判別OUTLINE, true="ok" FALSE="NG"
' "NG"家數起始值 ,目的"將有"ng"家數記錄在"L3"欄位用於是否繼續判別OUTLINE
Worksheets(wr).Range("L" & angin_sr - 3).Value = 0
' 開始判別從本次起始列開始
again_ai = angin_sr
For again_ai = again_ai To ((angin_sr) + Worksheets(wr).Range("A" & angin_sr - 3).Value - 1)
' 比對D6是否< E178值(I3)欄
If Worksheets(wr).Range("D" & again_ai).Value < Worksheets(wr).Range("I" & angin_sr - 3).Value Then
' 值=TRUE時E欄記錄""OK"
Worksheets(wr).Range("E" & again_ai).Value = "OK"
Else
' 值= FLACE時E欄記錄"NG"
Worksheets(wr).Range("E" & again_ai).Value = "NG"
' 設"NG"FONT.COLOR為紅色
Worksheets(wr).Range("E" & again_ai).Font.Color = vbRed
' "NG"家數+1
Worksheets(wr).Range("L" & angin_sr - 3).Value = Worksheets(wr).Range("L" & angin_sr - 3).Value + 1
End If
Next again_ai
' 如果還有"NG"值繼續執行OUTLINE
' 將本次表格列數值設定給上次表格列數目的將本次表格列數作為下次表格計算基礎
sr = angin_sr
Loop
' ********此處為Worksheets(wr).Cells((sr - 3), 12).Value =0."NG" 家數=0 全部""可執行Z-SCORE
' 定義z_sr為z_score起始表格列
Dim z_sr As Integer
angin_sr = sr ' 將sr值回愎給angin_sr目的為把最後一次outline "sr=angin_sr"回愎回來
sr = 6 ' 將sr回愎到第一次表格起始位置
' z_sr=執行z-score起始列為:最後一次起始列數+最後分析家數+6格空格
z_sr = angin_sr + (Worksheets(wr).Cells((angin_sr - 3), 1).Value + 6)
' 設定元素z_score標題列標題(z_score的第三列)
Worksheets(wr).Cells((z_sr - 2), 1).Value = "執行"
Worksheets(wr).Cells((z_sr - 2), 2).Value = Worksheets(wr).Name
Worksheets(wr).Cells((z_sr - 2), 3).Value = "z_score"
' 將第一次表格"實驗室編號"(第一行號)與"分析值"(第二行)copy至z_score表格因為要全部"實驗室編號"與"分析值"
Dim z_oi, z_oj As Integer ' 第一次表格列,行數計數器
Dim z_ai, z_aj As Integer ' z-score表格列,行數計數器
z_oi = sr ' z_oi定義為第一次起始格表格開始計數
z_ai = z_sr ' z_ai定義為z_score起始表格開始計數
For z_oi = z_oi To sr + Worksheets(wr).Cells((sr - 3), 1).Value
With Worksheets(wr)
.Cells(z_ai, 1).Value = .Cells(z_oi, 1).Value
.Cells(z_ai, 2).Value = .Cells(z_oi, 2).Value
End With
z_ai = z_ai + 1
Next z_oi

複製代碼

[attach]11772[/attach]

作者: c_c_lai 時間: 2012-7-20 16:44

本帖最後由 c_c_lai 於 2012-7-20 16:46 編輯

回復 8# lamihsuen
因程式碼大於規定大小，故將下半段再次貼上。

' 將最後一次第一列(公式)標題列標題與第二列公式值copy 至ZSCORE表格第一列與第二列
z_oi = angin_sr
z_ai = z_sr
z_aj = 1
For z_oj = 1 To 12
Worksheets(wr).Cells(z_ai - 4, z_aj).Value = Worksheets(wr).Cells(z_oi - 4, z_oj).Value
Worksheets(wr).Cells(z_ai - 3, z_aj).Value = Worksheets(wr).Cells(z_oi - 3, z_oj).Value
z_aj = z_aj + 1
Next z_oj
' 定義第四列表格標題列
xlRow = Worksheets(wr).Range("B" & z_sr).End(xlDown).Row
With Worksheets(wr)
.Cells((z_sr - 1), 1).Value = .Cells((sr - 1), 1).Value
.Cells((z_sr - 1), 2).Value = .Cells((sr - 1), 2).Value
.Cells((z_sr - 1), 3).Value = .Cells((sr - 1), 3).Value
.Cells((z_sr - 1), 4).Value = "判別結果"
.Cells((z_sr - 1), 5).Value = "分析方法"
.Cells((z_sr - 1), 6).Value = "使用儀器"
' 本次"C"欄 Z-SCORE 值計算
.Range("C" & z_sr & " :C" & xlRow).Formula = "=(b" & z_sr & "-$B$" & z_sr - 3 & ") /$C$" & z_sr - 3
.Range("D" & z_sr & " :D" & xlRow).Formula = "=IF(C" & z_sr & ">=3,""異常"",IF( C" & z_sr & "<=2,""ok"",""有質疑""))"
End With
' 定義z值判別結果並顯示(D)欄,"(Z)值<=2為"OK"顯示綠色","2<(Z)值<3為"有質疑"顯示黃色,(Z)值>3為"異常"顯示紅色
' 繪製統計分析圖表
Call DrawStatistics(wr)
Next wr
End Sub
Sub DrawStatistics(ct As Integer)
Dim tbl As String
StartKBarRow = 6
With Worksheets(ct)
tbl = .Name
EndKBarRow = .Range("A1").CurrentRegion.Rows.Count
Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))
sPos(1) = CInt(Mid("205*090*090*100*132*096*132*090*173*090*314*090", (ct - 4) * 4 + 1, 3))
sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3))
sPos(3) = CInt(Mid("720*720*720*720*720*720*720*720*720*720*720*720", (ct - 4) * 4 + 1, 3))
sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3))
xText = UCase(tbl) & " : Z - Score"
製圖程序 xlSh:=tbl
End With
End Sub
Private Sub 製圖程序(xlSh As String) ' 全部重繪
Dim Sh As Worksheet, xi As Integer
Set Sh = Sheets(xlSh)
Sh.ChartObjects.Delete
With Sh.ChartObjects.Add(Sh.Cells(sPos(1), sPos(2)).Left, Sh.Cells(sPos(1), sPos(2)).Top, sPos(3), sPos(4)).Chart
.ChartType = xlColumnClustered ' xlColumnStacked ' xlColumnStacke-> 堆疊直條圖
.SetSourceData Source:=Chart_Source
.HasLegend = 0 ' 圖表的圖例: 不可見
.SeriesCollection(1).AxisGroup = 1
With .Axes(xlCategory) ' X座標軸
.CategoryType = xlCategoryScale
' .TickLabels.NumberFormatLocal = "hh:mm"
.MajorTickMark = xlNone
.Border.Weight = xlHairline
.Border.LineStyle = xlNone
.TickLabelPosition = xlLow
.TickLabels.Font.Size = 10
End With
'*******************************************************************
With .SeriesCollection(1)
.Shadow = False ' 圖表中的數列(1)
.InvertIfNegative = True
' .InvertColor = RGB(255, 124, 128) ' 當表列數值為負值時，將其顯示之顏色更變成淺天藍色
.InvertColor = RGB(32, 178, 208) ' 當表列數值為負值時，將其顯示之顏色更變成青藍色
With .Format.Fill
.Visible = msoTrue
' .ForeColor.RGB = RGB(149, 179, 215) ' 當表列數值為正值時，顯示之顏色為橘紅色
.ForeColor.RGB = RGB(255, 69, 0) ' 當表列數值為正值時，顯示之顏色為粉紅色
.Transparency = 0
.Solid
End With
With .Border
.Weight = xlHairline
.LineStyle = xlNone
End With
' With .Interior
' .ColorIndex = 5
' .PatternColorIndex = 42
' .Pattern = xlSolid
' End With
End With
' *******************************************************************
With .Axes(xlValue).TickLabels.Font ' Y座標軸上刻度的刻度標籤的字體
.FontStyle = "標準"
.Size = 10
End With
With .Axes(xlValue)
.MajorUnit = 2 ' 圖表左側數列之間距值設定
' .MaximumScale = 30
' .MinimumScale = -40
End With
.HasTitle = True ' 圖表的標題可見
With .ChartTitle ' 圖表的標題
.Top = 1
.Text = xText
.Font.Size = 16
End With
With .PlotArea ' 圖表的繪圖區
.Top = 16
.Left = 1
.Width = sPos(3)
.Height = sPos(4)
.Interior.ColorIndex = xlNone
End With
End With
End Sub

複製代碼

應該滿足妳的要求了吧！

作者: lamihsuen 時間: 2012-7-20 20:21

回復 10# c_c_lai

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

作者: c_c_lai 時間: 2012-7-20 20:36

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

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

複製代碼

[attach]11784[/attach]

作者: c_c_lai 時間: 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() 內宣告的。當初開始撰寫時，原本考慮會跨涵式而將它置放於外部，程式改了改卻忘掉了。
嗎？

作者: c_c_lai 時間: 2012-7-21 06:29

本帖最後由 c_c_lai 於 2012-7-21 06:42 編輯

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

Sub DrawStatistics(ct As Integer)
Dim tbl As String
Dim totalRow As Long
StartKBarRow = 6
With Worksheets(ct)
tbl = .Name
EndKBarRow = .Range("A1").CurrentRegion.Rows.Count
Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))
' 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
sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3)) ' 圖標座標(欄)
sPos(3) = CInt(Mid("900*900*900*900*900*900*900*900*900*900*900*900", (ct - 4) * 4 + 1, 3)) ' 圖表寬度
sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3)) ' 圖表高度
xText = UCase(tbl) & " : Z - Score"
製圖程序 xlSh:=tbl
End With
End Sub

複製代碼

祝周末愉快！

作者: c_c_lai 時間: 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 的運用差異性。

作者: lamihsuen 時間: 2012-7-21 09:42

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

作者: lamihsuen 時間: 2012-7-21 12:26

本帖最後由 lamihsuen 於 2012-7-21 12:28 編輯

[attach]11799[/attach]回復 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
感謝大哥詳細解釋讓我受益良多,有你我不用怕會有白頭髮了
[attach]11799[/attach]

作者: c_c_lai 時間: 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 稍稍整理了一下，請留意是那些變化了？

Option Explicit
Dim sPos(1 To 4)
Dim xText As String
Dim Chart_Source As Variant
Public Sub 再分析結果()
Dim wr As Integer, an As Integer ' 設定COPY工作表數目計數器
Dim xlRow As Long
Dim angin_sr As Integer ' 下次起始列起點
Dim sr As Integer ' 定義第一次起始列數
Dim NGValue As Integer ' 計算 "NG" 的家數
Dim again_oi, again_oj As Integer ' 上次表格列,行數計數器
Dim again_ai, again_aj As Integer ' 本次表格列,行數計數器
Dim chart_end As Integer
Dim z_sr As Integer
Dim z_oi, z_oj As Integer ' 第一次表格列,行數計數器
Dim z_ai, z_aj As Integer ' z-score表格列,行數計數器
Dim mue_sr, mue_oi As Integer
' wr = 4 目前預設從 c 到 sn，總共有 12 個工作表單
For wr = 4 To Worksheets.Count
sr = 6
an = 1
NGValue = 0
With Worksheets(wr)
' 工作表從 4 迴圈開始執行再分析結果到工作表的最後
Do Until .Cells((sr - 3), 12).Value = 0
' outline 分析次數 + 1.並顯示在標題列 (B4) 儲存格
an = an + 1
' angin_sr=再次分析起始列為:第一次起始列數+第一次家數+6格空格
angin_sr = sr + (.Cells((sr - 3), 1).Value + 6)
' 判別上次分析有"NG"的去除,"OK"的COPY到本次表格
again_oi = sr
again_ai = angin_sr
' 迴圈判別 "ok" 與 "ng" 從前次起始位置開始(sr)至前次表格最後(sr+前次表格"a"3)的值
For again_oi = again_oi To (sr + .Cells((sr - 3), 1).Value - 1)
' 如果值為"ok"該列copy 到本次表格.如果值為"ng"則不處理
If .Cells(again_oi, 5).Value = "OK" Then
.Cells(again_ai, 1).Value = .Cells(again_oi, 1).Value
.Cells(again_ai, 2).Value = .Cells(again_oi, 2).Value
again_ai = again_ai + 1
End If
Next again_oi
' 將前次第三列標題列標題 copy 至本次表格第三列標題列標題
again_aj = 1
For again_oj = 1 To 12
.Cells(angin_sr - 4, again_aj).Value = .Cells(sr - 4, again_oj).Value
again_aj = again_aj + 1
Next again_oj
' 利用變數求出本次表格最後列數目的用於求出第三列公式的最後範圍
xlRow = .Range("B" & angin_sr).End(xlDown).Row
chart_end = xlRow
' 計算本次 "A3" 儲存格 NO.OF.RESULT值(分析值家數)從本次起始列至(angin_sr)至本次最後列數的數量
.Cells(angin_sr - 3, 1).Formula = "=COUNT(B" & angin_sr & ":B" & xlRow & ")"
' 本次 "B3" 儲存格分析值中間值 (MEDIAN)
.Cells(angin_sr - 3, 2).Formula = "=MEDIAN(B" & angin_sr & ":B" & xlRow & ")"
' 本次 C3 儲存格 IRQ 植
.Cells(angin_sr - 3, 3).Formula = "=(QUARTILE(B" & angin_sr & ":B" & xlRow & ",3) -QUARTILE(B" & angin_sr & ":B" & xlRow & ",1))*0.7413"
' 本次 "E3" 儲存格ROBUS CV值
.Cells(angin_sr - 3, 5).Formula = "= C3 / B3 *100"
' 本次 "F3" 儲存格分析值中最少值
.Cells(angin_sr - 3, 6).Formula = "=MIN(B" & angin_sr & ":B" & xlRow & ")"
' 本次 "G3" 儲存格分析值中最大值
.Cells(angin_sr - 3, 7).Formula = "=MAX(B" & angin_sr & ":B" & xlRow & ")"
' 本次 "H3" 儲存格RANGE值
.Cells(angin_sr - 3, 8).Formula = "=G3-F3"
' 本次定義 "I3" 儲存格為 E178 值
.Cells(angin_sr - 3, 9).Value = E178(.Cells(angin_sr - 3, 1).Value)
' 本次定義 "j3" 儲存格為分析值平均值
.Cells(angin_sr - 3, 10).Formula = "=AVERAGE(B" & angin_sr & ":B" & xlRow & ")"
' 本次定義 "k3" 儲存格為stdv
.Cells(angin_sr - 3, 11).Formula = "=STDEV(B" & angin_sr & ":B" & xlRow & ")"
' 本次 "NG" 家數值
.Cells(angin_sr - 3, 12).Value = NGValue
' 本次標題列 "執行第" 字串直接從前次儲存格位置 copy
.Cells(angin_sr - 2, 1).Value = .Cells(sr - 2, 1).Value
' 本次標題列顯示第 an 次分析
.Cells(angin_sr - 2, 2).Value = an
' 本次標題列 "ouline" 字串直接從前次儲存格位置 copy
.Cells(angin_sr - 2, 3).Value = .Cells(sr - 2, 3).Value
' 本次定義實驗室編號標題列直接從前次儲存格位置 copy
.Cells(angin_sr - 1, 1).Value = .Cells(sr - 1, 1).Value
' 本次定義實驗室分析值標題列直接從前次儲存格位置 copy
.Cells(angin_sr - 1, 2).Value = .Cells(sr - 1, 2).Value
' 本次定義z-score值標題列直接從前次儲存格位置 copy
.Cells(angin_sr - 1, 3).Value = .Cells(sr - 1, 3).Value
' 本次定義outline標題列直接從前次儲存格位置 copy
.Cells(angin_sr - 1, 4).Value = .Cells(sr - 1, 4).Value
' 定義判定結果值標題列直接從前次儲存格位置 copy
.Cells(angin_sr - 1, 5).Value = .Cells(sr - 1, 5).Value
' 本次 "C" 欄 Z-SCORE 值計算
.Range("C" & angin_sr & " :C" & xlRow).Formula = "=(b" & angin_sr & "-$B$" & angin_sr - 3 & ") /$C$" & angin_sr - 3
' 本次 "D" 欄 OUTLINE 值計算
.Range("d" & angin_sr & " :d" & xlRow).Formula = "= (B" & angin_sr & " -$J$" & angin_sr - 3 & ")/$K$" & angin_sr - 3
' 本次 "E' 欄判別 OUTLINE, true="ok" FALSE="NG"
' "NG"家數起始值 ,目的"將有"ng"家數記錄在"L3"欄位用於是否繼續判別 OUTLINE
.Range("L" & angin_sr - 3).Value = 0
' 開始判別從本次起始列開始
' again_ai = angin_sr
' For again_ai = again_ai To ((angin_sr) + .Range("A" & angin_sr - 3).Value - 1)
For again_ai = angin_sr To ((angin_sr) + .Range("A" & angin_sr - 3).Value - 1)
' 比對 D6 是否 < E178 值 (I3) 欄
If .Range("D" & again_ai).Value < .Range("I" & angin_sr - 3).Value Then
' 值 = TRUE 時 E 欄記錄 "OK"
.Range("E" & again_ai).Value = "OK"
Else
' 值 = FLACE時E欄記錄 "NG"
.Range("E" & again_ai).Value = "NG"
' 設 "NG" FONT.COLOR 為紅色
.Range("E" & again_ai).Font.Color = vbRed
' "NG" 家數 + 1
.Range("L" & angin_sr - 3).Value = .Range("L" & angin_sr - 3).Value + 1
End If
Next again_ai
' 如果還有 "NG" 值繼續執行 OUTLINE
' 將本次表格列數值設定給上次表格列數目的將本次表格列數作為下次表格計算基礎
sr = angin_sr
Loop
' ********此處為.Cells((sr - 3), 12).Value =0."NG" 家數=0 全部""可執行Z-SCORE
' 定義z_sr為z_score起始表格列
angin_sr = sr ' 將 sr 值回愎給 angin_sr 目的為把最後一次 outline "sr=angin_sr" 回愎回來
sr = 6 ' 將sr回愎到第一次表格起始位置
' z_sr = 執行 z-score 起始列為: 最後一次起始列數 + 最後分析家數 + 6 格空格
z_sr = angin_sr + (.Cells((angin_sr - 3), 1).Value + 6)
' 設定元素 z_score 標題列標題 (z_score 的第三列)
.Cells((z_sr - 2), 1).Value = "執行"
.Cells((z_sr - 2), 2).Value = .Name
.Cells((z_sr - 2), 3).Value = "z_score"
' 將第一次表格 "實驗室編號" (第一行號)與 "分析值" (第二行) copy 至 z_score 表格因為要全部 "實驗室編號" 與 "分析值"
z_oi = sr ' z_oi 定義為第一次起始格表格開始計數
z_ai = z_sr ' z_ai 定義為 z_score 起始表格開始計數
For z_oi = z_oi To sr + .Cells((sr - 3), 1).Value
.Cells(z_ai, 1).Value = .Cells(z_oi, 1).Value
.Cells(z_ai, 2).Value = .Cells(z_oi, 2).Value
z_ai = z_ai + 1
Next z_oi

複製代碼

作者: c_c_lai 時間: 2012-7-21 17:51

回復 17# lamihsuen

' 將最後一次第一列(公式)標題列標題與第二列公式值 copy 至 ZSCORE 表格第一列與第二列
z_oi = angin_sr
z_ai = z_sr
z_aj = 1
For z_oj = 1 To 12
.Cells(z_ai - 4, z_aj).Value = .Cells(z_oi - 4, z_oj).Value
.Cells(z_ai - 3, z_aj).Value = .Cells(z_oi - 3, z_oj).Value
z_aj = z_aj + 1
Next z_oj
' 定義第四列表格標題列
xlRow = .Range("B" & z_sr).End(xlDown).Row
.Cells((z_sr - 1), 1).Value = .Cells((sr - 1), 1).Value
.Cells((z_sr - 1), 2).Value = .Cells((sr - 1), 2).Value
.Cells((z_sr - 1), 3).Value = .Cells((sr - 1), 3).Value
.Cells((z_sr - 1), 4).Value = "判別結果"
.Cells((z_sr - 1), 5).Value = "分析方法"
.Cells((z_sr - 1), 6).Value = "使用儀器"
' 本次 "C" 欄 Z-SCORE 值計算
' .Range("C" & z_sr & " :C" & xlRow).Formula = "=(b" & z_sr & "-$B$" & z_sr - 3 & ") /$C$" & z_sr - 3
' .Range("D" & z_sr & " :D" & xlRow).Formula = "=IF(C" & z_sr & ">=3,""異常"",IF( C" & z_sr & "<=2,""ok"",""有質疑""))"
' 2012/7/20 新增列
' 判別本次 "C" 欄 Z-SCORE 值如果是 outline 則 z 值顯示 "*"
' 設定 mue_sr, mue_oi 為 z 值欄位計數器
mue_sr = z_sr
mue_oi = angin_sr
For mue_sr = mue_sr To xlRow
If .Cells(mue_sr, 1) = .Cells(mue_oi, 1) Then
.Cells(mue_sr, 3).Formula = "=(b" & mue_sr & "-$B$" & z_sr - 3 & ") /$C$" & z_sr - 3
If .Cells(mue_sr, 3).Value > 3 Or .Cells(mue_sr, 3).Value <= -3 Then
.Cells(mue_sr, 3).Font.Color = RGB(255, 0, 255)
End If
mue_oi = mue_oi + 1
Else
.Cells(mue_sr, 3).Value = "*"
.Cells(mue_sr, 3).Interior.Color = RGB(255, 0, 0)
.Cells(mue_sr, 3).HorizontalAlignment = xlHAlignCenter
End If
Next mue_sr
' 定義 z 值判別結果並顯示 (D) 欄,"(Z) 值 <= 2 為 "OK" 顯示綠色","2<(Z) 值 <3 為 "有質疑" 顯示黃色,(Z)值 >3 為 "異常" 顯示紅色
End With
' 繪製統計分析圖表
Call DrawStatistics(wr)
Next wr
End Sub
Sub DrawStatistics(ct As Integer)
Dim tbl As String
Dim totalRow As Long
Dim StartKBarRow, EndKBarRow As Long
StartKBarRow = 6
With Worksheets(ct)
tbl = .Name
EndKBarRow = .Range("A1").CurrentRegion.Rows.Count
Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))
' 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
sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3)) ' 圖標座標(欄)
sPos(3) = CInt(Mid("900*900*900*900*900*900*900*900*900*900*900*900", (ct - 4) * 4 + 1, 3)) ' 圖表寬度
sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3)) ' 圖表高度
xText = UCase(tbl) & " : Z - Score"
製圖程序 xlSh:=tbl
End With
End Sub
Private Sub 製圖程序(xlSh As String) ' 全部重繪
Dim Sh As Worksheet, xi As Integer
Set Sh = Sheets(xlSh)
Sh.ChartObjects.Delete
With Sh.ChartObjects.Add(Sh.Cells(sPos(1), sPos(2)).Left, Sh.Cells(sPos(1), sPos(2)).Top, sPos(3), sPos(4)).Chart
.ChartType = xlColumnClustered ' xlColumnStacked -> 堆疊直條圖
.SetSourceData Source:=Chart_Source
.HasLegend = 0 ' 圖表的圖例: 不可見
.SeriesCollection(1).AxisGroup = 1
With .Axes(xlCategory) ' X座標軸
.CategoryType = xlCategoryScale
' .TickLabels.NumberFormatLocal = "hh:mm"
.MajorTickMark = xlNone
.Border.Weight = xlHairline
.Border.LineStyle = xlNone
.TickLabelPosition = xlLow
.TickLabels.Font.Size = 10
End With
'*******************************************************************
With .SeriesCollection(1)
.Shadow = False ' 圖表中的數列(1)
.InvertIfNegative = True
' .InvertColor = RGB(255, 124, 128) ' 當表列數值為負值時，將其顯示之顏色更變成淺天藍色
.InvertColor = RGB(32, 178, 208) ' 當表列數值為負值時，將其顯示之顏色更變成青藍色
With .Format.Fill
.Visible = msoTrue
' .ForeColor.RGB = RGB(149, 179, 215) ' 當表列數值為正值時，顯示之顏色為橘紅色
.ForeColor.RGB = RGB(255, 69, 0) ' 當表列數值為正值時，顯示之顏色為粉紅色
.Transparency = 0
.Solid
End With
With .Border
.Weight = xlHairline
.LineStyle = xlNone
End With
.HasDataLabels = True
.DataLabels.NumberFormat = "##.##"
.DataLabels.Position = xlLabelPositionOutsideEnd
' With .Interior
' .ColorIndex = 5
' .PatternColorIndex = 42
' .Pattern = xlSolid
' End With
End With
' *******************************************************************
With .Axes(xlValue).TickLabels.Font ' Y座標軸上刻度的刻度標籤的字體
.FontStyle = "標準"
.Size = 10
End With
With .Axes(xlValue)
.MajorUnit = 2 ' 圖表左側數列之間距值設定
' .MaximumScale = 30
' .MinimumScale = -40
End With
.HasTitle = True ' 圖表的標題可見
With .ChartTitle ' 圖表的標題
.Top = 1
.Text = xText
.Font.Size = 16
End With
With .PlotArea ' 圖表的繪圖區
.Top = 16
.Left = 1
.Width = sPos(3)
.Height = sPos(4)
.Interior.ColorIndex = xlNone
End With
End With
End Sub

複製代碼

作者: lamihsuen 時間: 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
這樣可以嗎?

作者: c_c_lai 時間: 2012-7-21 23:33

回復 20# lamihsuen
請將 drawStatistics() 整個抽換掉：

Sub DrawStatistics(ct As Integer)
Dim tbl As String
Dim totalRow As Long
Dim StartKBarRow, EndKBarRow As Long
' StartKBarRow = 6
With Worksheets(ct)
tbl = .Name
' 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 ' 以 c 為例，總共使用(輸入)了 204 Rows 資料錄。
While IsEmpty(.Cells(sPos(1), 3).Value) And sPos(1) > 6 ' 尚須再次過濾部分空白與非真實匯入資料的問題列
sPos(1) = sPos(1) - 1
Wend
' EndKBarRow = .Range("A1").CurrentRegion.Rows.Count ' 以 c 為例，判斷A1:A51區間實際使用了(共有)多少列(Rows)
' 以 c 為例，A155:A204 間總共使用了多少列(50)。接著再求出上一個區間的最後一行的所在行數 (204-50-2(空白列)=152)。
EndKBarRow = sPos(1) - .Range("A" & sPos(1)).CurrentRegion.Rows.Count - 2
' 以 c 為例， A105:A152 間總共使用了多少列(48)。接著再求出本區間的第一行的所在行數 (152-48+5(標題列)=109)。
StartKBarRow = EndKBarRow - .Range("A" & EndKBarRow).CurrentRegion.Rows.Count + 5
If (StartKBarRow < 6) Then StartKBarRow = 6 ' < 6 則加 1，因起始列最少為 6。
Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))
sPos(1) = sPos(1) + 5 ' 圖標座標(列)
sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3)) ' 圖標座標(欄)
sPos(3) = CInt(Mid("900*900*900*900*900*900*900*900*900*900*900*900", (ct - 4) * 4 + 1, 3)) ' 圖表寬度
sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3)) ' 圖表高度
xText = UCase(tbl) & " : Z - Score"
製圖程序 xlSh:=tbl
End With
End Sub

複製代碼

晚安！

作者: c_c_lai 時間: 2012-7-21 23:39

回復 20# lamihsuen
Sub DrawStatistics(ct As Integer)
Dim tbl As String
Dim totalRow As Long
Dim StartKBarRow, EndKBarRow As Long

' StartKBarRow = 6
With Worksheets(ct)
      tbl = .Name
      ' 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                            ' 以 c 為例，總共使用(輸入)了 204 Rows 資料錄。
      While IsEmpty(.Cells(sPos(1), 3).Value) And sPos(1) > 6    ' 尚須再次過濾部分空白與非真實匯入資料的問題列
         sPos(1) = sPos(1) - 1
      Wend

      ' EndKBarRow = .Range("A1").CurrentRegion.Rows.Count ' 以 c 為例，判斷A1:A51區間實際使用了(共有)多少列(Rows)
      ' 以 c 為例，A155:A204 間總共使用了多少列(50)。接著再求出上一個區間的最後一行的所在行數 (204-50-2(空白列)=152)。
      EndKBarRow = sPos(1) - .Range("A" & sPos(1)).CurrentRegion.Rows.Count - 2
      ' 以 c 為例， A105:A152 間總共使用了多少列(48)。接著再求出本區間的第一行的所在行數 (152-48+5(標題列)=109)。
      StartKBarRow = EndKBarRow - .Range("A" & EndKBarRow).CurrentRegion.Rows.Count + 5
      If (StartKBarRow < 6) Then StartKBarRow = 6       ' < 6 則加 1，因起始列最少為 6。

      Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))

      sPos(1) = sPos(1) + 5                                                                      ' 圖標座標(列)
      sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3)) ' 圖標座標(欄)
      sPos(3) = CInt(Mid("900*900*900*900*900*900*900*900*900*900*900*900", (ct - 4) * 4 + 1, 3)) ' 圖表寬度
      sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3)) ' 圖表高度
      xText = UCase(tbl) & " : Z - Score"
      製圖程序 xlSh:=tbl
End With
End Sub

作者: c_c_lai 時間: 2012-7-22 06:38

論壇網頁資料是否有異狀？

作者: c_c_lai 時間: 2012-7-22 07:54

本帖最後由 c_c_lai 於 2012-7-22 08:01 編輯

2012/7/22 加入 XValues 設定圖表數列中 X 值的陣列。請將 "製圖程序()" 中 .AxisGroup = 1 的下一列增加一行：
.SeriesCollection(1).XValues = Range(Sh.Name & "!$A$" & CStr(StartKBarRow) & ":" & Sh.Name & "!$A$" & CStr(EndKBarRow))
如下所示：

Private Sub 製圖程序(xlSh As String)                               ' 全部重繪
Dim Sh As Worksheet, xi As Integer

Set Sh = Sheets(xlSh)
Sh.ChartObjects.Delete

With Sh.ChartObjects.Add(Sh.Cells(sPos(1), sPos(2)).Left, Sh.Cells(sPos(1), sPos(2)).Top, sPos(3), sPos(4)).Chart
      .ChartType = xlColumnClustered                         ' xlColumnStacked -> 堆疊直條圖
      .SetSourceData Source:=Chart_Source
      .HasLegend = 0                                                          ' 圖表的圖例:  不可見
      .SeriesCollection(1).AxisGroup = 1
      ' 2012/7/22 加入 XValues 設定圖表數列中 X 值的陣列。原本未設定是以數列序號處理，故予以修正以符事實。
      .SeriesCollection(1).XValues = Range(Sh.Name & "!$A$" & CStr(StartKBarRow) & ":" & Sh.Name & "!$A$" & CStr(EndKBarRow))

同時將 StartKBarRow 與 EndKBarRow 的變數宣告從 DrawStatistics() 中移置公用變數宣告區塊。

Option Explicit

Dim sPos(1 To 4)
Dim xText As String
Dim Chart_Source As Variant
' 因於 DrawStatistics() 以及製圖程序() 函式內均需使用，故將此兩變數改為公用變數
Dim StartKBarRow, EndKBarRow As Long

到此我想應該業已大功告成了吧，祝妳學業猛進！

P.S. 最後再贈送一個小禮物 ("##.##" 改成如下，閱覽會更明確)：
.DataLabels.NumberFormat = "#0.##"

作者: lamihsuen 時間: 2012-7-22 16:02

回復 30# c_c_lai
c_c_lai 大哥  對不起還没完成最終目標,可以看看再現在傳給你檔案是我要用vba語法完成的最終目標整個過程如下敍述
  1 先初始分析結果表
2  再執行outline判別  , 如果合格就記錄"ok"不合格就記錄"ng"
3  如果有"ng"值去除"ng"該列,  把"ok"列copy 到下一次表格區間再執行outline判別,(因為列數(家數)減少,判別值會改變)
  4  一直到全部都"ok"時這個表格區間是我圖表資料的來源5 最後再增加一表格區間(稱為執行z_score)把全部列數(家數)copy 到最後表格區間 (執行z_score)作z_score判別
5 再完成報告書
[attach]11816[/attach]

作者: lamihsuen 時間: 2012-7-22 16:57

回復 30# c_c_lai
c_c_lai大哥加入下列時

. SeriesCollection(1).XValues = Range(Sh.Name & "!$A$" & CStr(StartKBarRow) & ":" & Sh.Name & "!$A$" & CStr(EndKBarRow))
會出現"執行階段錯誤'1004'range方法('global'物件失敗)

作者: lamihsuen 時間: 2012-7-22 17:46

回復 30# c_c_lai
c_c_lai 大哥, 原諒我的迷糊.我把Dim StartKBarRow, EndKBarRow As Long從製圖程式移除後程式就能正確執行

作者: c_c_lai 時間: 2012-7-22 20:11

本帖最後由 c_c_lai 於 2012-7-24 21:06 編輯

回復 8# lamihsuen
網頁好像有問題，有的內容根本看不到訊息，

作者: lamihsuen 時間: 2012-7-23 10:14

c_c_lai 大哥, 請問列表第三頁以後都不見了,要如何叫出

作者: lamihsuen 時間: 2012-7-24 18:14

回復 28# c_c_lai
c_c_lai 大哥請問如何設定讓圖表區與繪圖區底部空間大一點,我加入水平軸標題時都會與類別標籤重疉

作者: c_c_lai 時間: 2012-7-25 07:44

回復 30# lamihsuen
原本為

With .PlotArea ' 圖表的繪圖區
.Top = 16
.Left = 1
.Width = sPos(3)
.Height = sPos(4)
.Interior.ColorIndex = xlNone
End With

複製代碼

修正為

With .PlotArea ' 圖表的繪圖區
.Top = 16
.Left = 1
.Width = sPos(3)
.Height = sPos(4)
.Interior.ColorIndex = xlNone
' 可依個人之考量予以增減內部圖表的高、低、以及寬度
.InsideLeft = 40
.InsideTop = Sheets(xlSh).Rows(3).RowHeight * 2
.InsideWidth = sPos(3) - 50
.InsideHeight = sPos(4) - 5 * Sheets(xlSh).Rows(3).RowHeight
End With

複製代碼

試試看！

作者: c_c_lai 時間: 2012-7-25 07:46

回復 30# lamihsuen
剛傳的怎麼又不見了？？？？？？

作者: c_c_lai 時間: 2012-7-27 15:17

本題目因網頁有些怪異(第三頁有些回應都自動消失無影)，且問題業已另行解決。
應予以結案。

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)