我的统计质量控制图表VB代码中的错误
我在网上发现了一个macros在线创build统计质量控制图。 所以我有一个.Csv文件，看起来像一个Excel表。 我使用macros，所以我必须select数据点。 然后，我必须select标签，然后绘制。
我的问题是UL2 =（上限，2 *标准偏差）和LL2 =（下限，2 *标准偏差）的误差条根本没有出现。 所有其他错误栏显示。 如平均，UL（上限）和LL（下限）以及UL3和LL3，但不是UL2和LL2。
此外，数据点不是沿着它们应该是的平均线，它们也被移位。
我使用的示例表显示了他们，但是这是在一个常规的Excel文件。 我将它作为.CSV文件的原因是因为我使用另一个macros来提取原始数据，并将其粘贴到新的.csv文件中。 我认为这是原因，但我不是100％肯定的。 我想知道你们是否可以帮助我。 我对VBA相当陌生，请耐心等待。
谢谢！
这是创build控制图的代码：
Option Explicit Public Function GetRange(box_message As String) As Range Set GetRange = Nothing On Error Resume Next Set GetRange = Application.InputBox(box_message, "Select Range", Selection.Address, , , , , 8) End Function Public Function IsNotOk(ByVal rng As Range) As Boolean 'TO CHECK IF A GIVEN RANGE IS BLANK IsNotOk = True On Error GoTo if_error_occured: If rng.Rows.Count > 0 And rng.Columns.Count = 1 Then IsNotOk = False if_error_occured: If Err.Number Then IsNotOk = True End Function Public Function check_if_numeric(rng As Range) As Boolean Dim cel As Range check_if_numeric = True For Each cel In rng.Cells If Not (Application.WorksheetFunction.IsNumber(cel.Value)) Then check_if_numeric = False Next cel End Function Sub make_control_chart() Dim data_values As Range Dim chart_labels As Range Dim range_selected_before As Range Dim got_label_range As Boolean Dim got_value_range As Boolean Dim bActivate As Boolean Dim myChtObj As ChartObject Dim plot_series, MyNewSrs As Series Dim series_label As String Dim number_of_control_limits As Integer Dim standard_deviation As Integer Dim data_str As String Dim avg_str As String On Error GoTo if_error_occured: 'GOTO THE END OF THE PROGRAM 'GET RANGE FOR DATA VALUES bActivate = False ' True to re-activate the input range Set data_values = GetRange("Please select the range containing the DATA POINTS" & Chr(13) & "(press select a single column)") If IsNotOk(data_values) Then MsgBox "Incorrect Input Data !" End ElseIf Not (check_if_numeric(data_values)) Then MsgBox "Incorrect Input Data !" End End If 'GET RANGE FOR CHART X-AXIS LABELS got_label_range = True ' True to re-activate the input range Set chart_labels = GetRange("Please select the range containing the LABELS" & Chr(13) & "(press ESC if no labels available)") If IsNotOk(chart_labels) Then got_label_range = False End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'LETS CREATE THE CHART NOW Set myChtObj = ActiveSheet.ChartObjects.Add(Left:=300, Width:=450, Top:=25, Height:=300) myChtObj.Chart.ChartType = xlLineMarkers 'REMOVE ALL UNWANTED SERIES FROM CHART, IF ANY For Each MyNewSrs In myChtObj.Chart.SeriesCollection ' myChtObj.Chart.SeriesCollection MyNewSrs.Delete Next MyNewSrs Set MyNewSrs = Nothing If got_label_range Then 'IF WE HAVE THE LABEL RANGE 'ADD NEW SERIES Set MyNewSrs = myChtObj.Chart.SeriesCollection.NewSeries With MyNewSrs .Name = "PLOT" .Values = data_values .XValues = chart_labels.Value End With Else Set MyNewSrs = myChtObj.Chart.SeriesCollection.NewSeries With MyNewSrs .Name = "PLOT" .Values = data_values End With End If 'FORMAT THE PLOT SERIES Set plot_series = MyNewSrs With MyNewSrs .Border.ColorIndex = 1 .MarkerBackgroundColorIndex = 2 .MarkerForegroundColorIndex = xlAutomatic .MarkerStyle = xlCircle .Smooth = False .MarkerSize = 5 .Shadow = False End With Set MyNewSrs = Nothing 'CREATE NAMED RANGE FOR THE DATA VALUES, AVERAGE, LOWER AND UPPER CONTROL LIMITS data_str = Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_data_values" avg_str = "roundup(average(" & Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_data_values" & "),2)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_data_values", RefersToR1C1:=data_values ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_AVG", RefersToR1C1:="=" & avg_str & "" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_LCL1", RefersToR1C1:="=" & avg_str & "- roundup(1*stdev(" & data_str & "),2)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_LCL2", RefersToR1C1:="=" & avg_str & "- roundup(2*stdev(" & data_str & "),2)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_LCL3", RefersToR1C1:="=" & avg_str & "- roundup(3*stdev(" & data_str & "),2)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_UCL1", RefersToR1C1:="=" & avg_str & "+ roundup(1*stdev(" & data_str & "),2)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_UCL2", RefersToR1C1:="=" & avg_str & "+ roundup(2*stdev(" & data_str & "),2)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_UCL3", RefersToR1C1:="=" & avg_str & "+ roundup(3*stdev(" & data_str & "),2)" 'ADD THE LINE FOR AVERAGE Set MyNewSrs = myChtObj.Chart.SeriesCollection.NewSeries With MyNewSrs .Name = "AVG = " .Values = "='" & ActiveSheet.Name & "'!" & Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_AVG" .ChartType = xlXYScatter '.ErrorBar Direction:=xlX, Include:=xlNone, Type:=xlFixedValue, Amount:=10000 '.ErrorBar Direction:=xlX, Include:=xlUp, Type:=xlFixedValue, Amount:=20 .ErrorBar Direction:=xlX, Include:=xlPlusValues, Type:=xlFixedValue, Amount:=data_values.Rows.Count .MarkerBackgroundColorIndex = xlAutomatic .MarkerForegroundColorIndex = xlAutomatic .MarkerStyle = xlNone .Smooth = False .MarkerSize = 5 .Shadow = False With .Border .Weight = xlHairline .LineStyle = xlNone End With 'With .ErrorBars.Border ' .LineStyle = xlContinuous ' .ColorIndex = 3 ' .Weight = xlThin 'End With End With Set MyNewSrs = Nothing 'ADD UPPER AND LOWER CONTROL LIMITS For number_of_control_limits = 1 To 3 For standard_deviation = -1 To 1 Step 2 Select Case standard_deviation: Case -1: series_label = "LCL" Case 1: series_label = "UCL" End Select Set MyNewSrs = myChtObj.Chart.SeriesCollection.NewSeries With MyNewSrs .Name = series_label & number_of_control_limits & " =" .Values = "='" & ActiveSheet.Name & "'!" & Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_" & series_label & number_of_control_limits .ChartType = xlXYScatter .ErrorBar Direction:=xlX, Include:=xlPlusValues, Type:=xlFixedValue, Amount:=data_values.Rows.Count End With MyNewSrs.ErrorBar Direction:=xlX, Include:=xlPlusValues, Type:=xlFixedValue, Amount:=data_values.Rows.Count Select Case number_of_control_limits: Case 1: With MyNewSrs.ErrorBars.Border .LineStyle = xlGray25 .ColorIndex = 15 .Weight = xlHairline End With Case 2: With MyNewSrs.ErrorBars.Border .LineStyle = xlGray25 .ColorIndex = 57 .Weight = xlHairline End With Case 3: With MyNewSrs.ErrorBars.Border .LineStyle = xlGray75 .ColorIndex = 3 .Weight = xlHairline End With End Select MyNewSrs.ErrorBars.EndStyle = xlNoCap With MyNewSrs With .Border .Weight = xlHairline .LineStyle = xlNone End With .MarkerBackgroundColorIndex = xlAutomatic .MarkerForegroundColorIndex = xlAutomatic .MarkerStyle = xlNone .Smooth = False .MarkerSize = 5 .Shadow = False End With Set MyNewSrs = Nothing Next standard_deviation Next number_of_control_limits myChtObj.Chart.ApplyDataLabels AutoText:=True, LegendKey:=False, _ HasLeaderLines:=False, ShowSeriesName:=True, ShowCategoryName:=False, _ ShowValue:=True, ShowPercentage:=False, ShowBubbleSize:=False, Separator:=" " 'OFFSET THE LABELS For Each MyNewSrs In myChtObj.Chart.SeriesCollection With MyNewSrs.Points(1).DataLabel .Left = 400 End With Next MyNewSrs 'LETS FORMAT THE CHART With myChtObj With .Chart.Axes(xlCategory) .MajorTickMark = xlNone .MinorTickMark = xlNone .TickLabelPosition = xlNextToAxis End With With .Chart.Axes(xlValue) .MajorTickMark = xlOutside .MinorTickMark = xlNone .TickLabelPosition = xlNextToAxis End With With .Chart.ChartArea.Border .Weight = 1 .LineStyle = 0 End With With .Chart.PlotArea.Border .ColorIndex = 1 .Weight = xlThin .LineStyle = xlContinuous End With With .Chart.PlotArea.Interior .ColorIndex = 2 .PatternColorIndex = 1 .Pattern = xlSolid End With With .Chart.ChartArea.Font .Name = "Arial" .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .Background = xlAutomatic End With With .Chart .HasTitle = False .Axes(xlCategory, xlPrimary).HasTitle = False .Axes(xlValue, xlPrimary).HasTitle = True .HasTitle = True .ChartTitle.Characters.Text = "Control Chart" .ChartTitle.Left = 134 .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Observations" End With With .Chart.Axes(xlCategory).TickLabels .Alignment = xlCenter .Offset = 100 .ReadingOrder = xlContext .Orientation = xlHorizontal End With End With myChtObj.Chart.Legend.Delete myChtObj.Chart.PlotArea.Width = 310 myChtObj.Chart.Axes(xlValue).MajorGridlines.Delete myChtObj.Chart.Axes(xlValue).CrossesAt = myChtObj.Chart.Axes(xlValue).MinimumScale myChtObj.Chart.ChartArea.Interior.ColorIndex = xlAutomatic myChtObj.Chart.ChartArea.AutoScaleFont = True 'DELETE THE LABELS FOR THE ACTUAL DATA SERIES plot_series.DataLabels.Delete Set plot_series = Nothing if_error_occured: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If Err.Number Then z_delete_all_named_range End Sub Sub z_delete_all_named_range() Dim nam As Name Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic For Each nam In ActiveWorkbook.Names nam.Delete Next nam End Sub 
这是我绘制时的样子。 UL2和LL2的错误栏也不存在。
所以LCL1和LCL2在舍入后（和UCL1 / UCL2）似乎是相同的值。 上面的综合函数只有两位小数。 要查看它们的区别，请将小数点后两位的舍入更改为3或4.build议将平均值更改为3/4小数位以匹配，但更新后的代码如下所示。
ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_LCL1", RefersToR1C1:="=" & avg_str & "- roundup(1*stdev(" & data_str & "),3)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_LCL2", RefersToR1C1:="=" & avg_str & "- roundup(2*stdev(" & data_str & "),3)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_LCL3", RefersToR1C1:="=" & avg_str & "- roundup(3*stdev(" & data_str & "),3)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_UCL1", RefersToR1C1:="=" & avg_str & "+ roundup(1*stdev(" & data_str & "),3)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_UCL2", RefersToR1C1:="=" & avg_str & "+ roundup(2*stdev(" & data_str & "),3)" ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_UCL3", RefersToR1C1:="=" & avg_str & "+ roundup(3*stdev(" & data_str & "),3)"