返回列表 上一主題 發帖

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

回復 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. Sub DrawStatistics(ct As Integer)
  49.     Dim tbl As String
  50.     Dim totalRow As Long
  51.     Dim StartKBarRow, EndKBarRow As Long

  52.     StartKBarRow = 6
  53.     With Worksheets(ct)
  54.         tbl = .Name
  55.         EndKBarRow = .Range("A1").CurrentRegion.Rows.Count
  56.         Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))
  57.         
  58.         ' sPos(1) = CInt(Mid("205*090*090*100*132*096*132*090*173*090*314*090", (ct - 4) * 4 + 1, 3)) ' 圖標座標(列)
  59.         ' 為考量在實務運用上,每張表單內含資料內容之多寡不一,可能實際使用列數時有增減,故改以動態處理。
  60.         sPos(1) = .UsedRange.Rows.Count
  61.         While IsEmpty(.Cells(sPos(1), 3).Value) And sPos(1) > 6       ' 尚須再次過濾部分空白與非真實匯入資料的問題列
  62.             sPos(1) = sPos(1) - 1
  63.         Wend
  64.         sPos(1) = sPos(1) + 5
  65.         
  66.         sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3))   ' 圖標座標(欄)
  67.         sPos(3) = CInt(Mid("900*900*900*900*900*900*900*900*900*900*900*900", (ct - 4) * 4 + 1, 3))   ' 圖表寬度
  68.         sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3))   ' 圖表高度
  69.         xText = UCase(tbl) & " : Z - Score"
  70.         製圖程序 xlSh:=tbl
  71.     End With
  72. End Sub

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

  78.     With Sh.ChartObjects.Add(Sh.Cells(sPos(1), sPos(2)).Left, Sh.Cells(sPos(1), sPos(2)).Top, sPos(3), sPos(4)).Chart
  79.         .ChartType = xlColumnClustered                          ' xlColumnStacked -> 堆疊直條圖
  80.         .SetSourceData Source:=Chart_Source
  81.         .HasLegend = 0                                          ' 圖表的圖例:  不可見
  82.         .SeriesCollection(1).AxisGroup = 1
  83.             
  84.         With .Axes(xlCategory)                                  ' X座標軸
  85.             .CategoryType = xlCategoryScale
  86.             ' .TickLabels.NumberFormatLocal = "hh:mm"
  87.             .MajorTickMark = xlNone
  88.             .Border.Weight = xlHairline
  89.             .Border.LineStyle = xlNone
  90.             .TickLabelPosition = xlLow
  91.             .TickLabels.Font.Size = 10
  92.         End With
  93.                   
  94.             '*******************************************************************
  95.                   
  96.         With .SeriesCollection(1)
  97.             .Shadow = False                                ' 圖表中的數列(1)
  98.             .InvertIfNegative = True
  99.             ' .InvertColor = RGB(255, 124, 128)                      ' 當表列數值為負值時,將其顯示之顏色更變成淺天藍色
  100.             .InvertColor = RGB(32, 178, 208)                         ' 當表列數值為負值時,將其顯示之顏色更變成青藍色
  101.         
  102.             With .Format.Fill
  103.                 .Visible = msoTrue
  104.                 ' .ForeColor.RGB = RGB(149, 179, 215)                ' 當表列數值為正值時,顯示之顏色為橘紅色
  105.                 .ForeColor.RGB = RGB(255, 69, 0)                     ' 當表列數值為正值時,顯示之顏色為粉紅色
  106.                 .Transparency = 0
  107.                 .Solid
  108.             End With
  109.         
  110.             With .Border
  111.                 .Weight = xlHairline
  112.                 .LineStyle = xlNone
  113.             End With
  114.         
  115.             .HasDataLabels = True
  116.             .DataLabels.NumberFormat = "##.##"
  117.             .DataLabels.Position = xlLabelPositionOutsideEnd
  118.             ' With .Interior
  119.             '     .ColorIndex = 5
  120.             '     .PatternColorIndex = 42
  121.             '     .Pattern = xlSolid
  122.             ' End With
  123.         End With
  124.                   
  125.         ' *******************************************************************
  126.                      
  127.         With .Axes(xlValue).TickLabels.Font                    ' Y座標軸上刻度的刻度標籤的字體
  128.             .FontStyle = "標準"
  129.             .Size = 10
  130.         End With
  131.                      
  132.         With .Axes(xlValue)
  133.             .MajorUnit = 2                                     ' 圖表左側數列之間距值設定
  134.             ' .MaximumScale = 30
  135.             ' .MinimumScale = -40
  136.         End With
  137.         
  138.         .HasTitle = True                                       ' 圖表的標題   可見
  139.               
  140.         With .ChartTitle                                       ' 圖表的標題
  141.             .Top = 1
  142.             .Text = xText
  143.             .Font.Size = 16
  144.         End With

  145.         With .PlotArea                                         ' 圖表的繪圖區
  146.             .Top = 16
  147.             .Left = 1
  148.             .Width = sPos(3)
  149.             .Height = sPos(4)
  150.             .Interior.ColorIndex = xlNone
  151.         End With
  152.     End With
  153. End Sub
複製代碼

TOP

回復 20# lamihsuen
請將 drawStatistics() 整個抽換掉:
  1. Sub DrawStatistics(ct As Integer)
  2.     Dim tbl As String
  3.     Dim totalRow As Long
  4.     Dim StartKBarRow, EndKBarRow As Long

  5.     ' StartKBarRow = 6
  6.     With Worksheets(ct)
  7.         tbl = .Name
  8.         ' sPos(1) = CInt(Mid("205*090*090*100*132*096*132*090*173*090*314*090", (ct - 4) * 4 + 1, 3)) ' 圖標座標(列)
  9.         ' 為考量在實務運用上,每張表單內含資料內容之多寡不一,可能實際使用列數時有增減,故改以動態處理。
  10.         sPos(1) = .UsedRange.Rows.Count                               ' 以 c 為例,總共使用(輸入)了 204 Rows 資料錄。
  11.         While IsEmpty(.Cells(sPos(1), 3).Value) And sPos(1) > 6       ' 尚須再次過濾部分空白與非真實匯入資料的問題列
  12.             sPos(1) = sPos(1) - 1
  13.         Wend
  14.         
  15.         ' EndKBarRow = .Range("A1").CurrentRegion.Rows.Count   ' 以 c 為例,判斷A1:A51區間實際使用了(共有)多少列(Rows)
  16.         ' 以 c 為例,A155:A204 間總共使用了多少列(50)。接著再求出上一個區間的最後一行的所在行數 (204-50-2(空白列)=152)。
  17.         EndKBarRow = sPos(1) - .Range("A" & sPos(1)).CurrentRegion.Rows.Count - 2
  18.         ' 以 c 為例, A105:A152 間總共使用了多少列(48)。接著再求出本區間的第一行的所在行數 (152-48+5(標題列)=109)。
  19.         StartKBarRow = EndKBarRow - .Range("A" & EndKBarRow).CurrentRegion.Rows.Count + 5
  20.         If (StartKBarRow < 6) Then StartKBarRow = 6          ' < 6 則加 1, 因起始列最少為 6。
  21.         
  22.         Set Chart_Source = Range(tbl & "!$C$" & CStr(StartKBarRow) & ":" & tbl & "!$C$" & CStr(EndKBarRow))
  23.         
  24.         sPos(1) = sPos(1) + 5                                                                         ' 圖標座標(列)
  25.         sPos(2) = CInt(Mid("001*001*001*001*001*001*001*001*001*001*001*001", (ct - 4) * 4 + 1, 3))   ' 圖標座標(欄)
  26.         sPos(3) = CInt(Mid("900*900*900*900*900*900*900*900*900*900*900*900", (ct - 4) * 4 + 1, 3))   ' 圖表寬度
  27.         sPos(4) = CInt(Mid("320*320*320*320*320*320*320*320*320*320*320*320", (ct - 4) * 4 + 1, 3))   ' 圖表高度
  28.         xText = UCase(tbl) & " : Z - Score"
  29.         製圖程序 xlSh:=tbl
  30.     End With
  31. End Sub
複製代碼
晚安!

TOP

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

TOP

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

TOP

本帖最後由 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.##"

TOP

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

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

TOP

回復 30# lamihsuen
原本為
  1.         With .PlotArea                                         ' 圖表的繪圖區
  2.             .Top = 16
  3.             .Left = 1
  4.             .Width = sPos(3)
  5.             .Height = sPos(4)
  6.             .Interior.ColorIndex = xlNone
  7.         End With
複製代碼
修正為
  1.         With .PlotArea                                         ' 圖表的繪圖區
  2.             .Top = 16
  3.             .Left = 1
  4.             .Width = sPos(3)
  5.             .Height = sPos(4)
  6.             .Interior.ColorIndex = xlNone
  7.             
  8.             ' 可依個人之考量予以增減內部圖表的高、低、以及寬度
  9.             .InsideLeft = 40
  10.             .InsideTop = Sheets(xlSh).Rows(3).RowHeight * 2
  11.             .InsideWidth = sPos(3) - 50
  12.             .InsideHeight = sPos(4) - 5 * Sheets(xlSh).Rows(3).RowHeight
  13.         End With
複製代碼
試試看!

TOP

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

TOP

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

TOP

        靜思自在 : 能善用時間的人,必能掌握自己努力的方向。
返回列表 上一主題