第3講 按不良大小排序並計算累積折線資料

用Excel VBA自動化地做柏拉圖例 - 第3講
1 第2講提到繪製柏拉圖資料的佈署範例如下表
[表2] A1:B9

	A	B	C
1	不良內容	不良率
2	AA	0.120
3	BB	0.020
4	CC	0.050
5	DD	0.010
6	Else	0.015
7
8	Item no.	5
9	Item else	1

為了繪製柏拉圖，需要將原始資料經由不良率排序(其他項不排序)、計算累積百分比才能以不良內容、不良率與累積百分比繪製柏拉圖，因此本講次內容需要排序與與計算
2 以下是本講次排序與與計算的流程
2-1 先重覆第2講內容取得不良項目數與是否有其他項(所以日後巨集count就不再使用，方便一鍵繪製柏拉圖)
2-2 清除D E F 三欄作為繪圖資料區
2-3 依據不良項目數複製所有資料到繪圖資料區
2-4 進行排序
2-5 清除 item no and else 的統計
2-6若沒有 else 項則清除繪圖資料區else項
2-7 計算不良合計與累積百分比
3 開始創建立第三個Excel巨集(名稱為 pareto)
目的：本次練習建巨集目的是對柏拉圖資料的複製、排序與累積百分比計算以便後續畫圖，結果將如表3 A1:F9
[表3] A1:F9

	A	B	C	D	E	F	G
1	不良內容	不良率		不良內容	不良率	累積比例
2	AA	0.120		AA	0.12	55.81%
3	BB	0.020		BB	0.05	79.07%
4	CC	0.050		CC	0.02	88.37%
5	DD	0.010		DD	0.01	93.02%
6	Else	0.015		Else	0.015	100.00%
7
8				合計	0.215
9

具體步驟(請繼續用第1講的Excel工作表跟著操作)
3-1 建立新巨集，名稱為 pareto
Sub pareto()
End sub
3-2 開始在Sub pareto()與End sub間Copy 以下指令
‘ -------------- 從此處開始 Copy ------------------
‘ -------macro by Geroge ---2009/7/14--------------
'
以下為第2講內容 - 日後是一鍵柏拉圖
Dim ct As Integer, i As Integer, p_tl As Double
ct = 0
Do
If Cells(ct + 2, 1) = "" Then
Exit Do
Else
ct = ct + 1
End If
Loop
Cells(ct + 3, 1) = "Item no."
Cells(ct + 4, 1) = "Item else"
If Cells(ct + 1, 2) = 0 Or Cells(ct + 1, 2) = "" Then
Cells(ct + 3, 2) = ct - 1
Cells(ct + 4, 2) = 0 '無 else 項
Else
Cells(ct + 3, 2) = ct
Cells(ct + 4, 2) = 1 '有 else 項
End If
' ------------------------------------------------
' 以下為第3講內容 需要延續第2講 - 日後是一鍵柏拉圖
' 先清除 D:F 三欄位
Range("D:F").Select
Selection.Clear
' Copy data 到繪圖數據區
For i = 1 To ct + 1
Cells(i, 4) = Cells(i, 1)
Cells(i, 5) = Cells(i, 2)
Next i
' 進行排序
i = Cells(ct + 3, 2) - Cells(ct + 4, 2) ' itemno to be sorted
Range("D2").Select
Range(Selection, Selection.Offset(i - 1, 1)).Select
Selection.Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod :=xlStroke, DataOption1:=xlSortNormal
' 清除 item no and else 統計
For i = 1 To 2
Cells(i + ct + 2, 1) = ""
Cells(i + ct + 2, 2) = ""
Next i
' 若沒有 else 項則清除繪圖資料區else項
If Cells(ct + 1, 2) = 0 Or Cells(ct + 1, 2) = "" Then '無 else 項
Cells(ct + 1, 4) = ""
Cells(ct + 1, 5) = ""
ct = ct - 1
End If
' 開始計算不良合計與累積百分比
Cells(ct + 3, 4) = "Total"
Cells(ct + 4, 4) = "Item ct"
Cells(ct + 4, 5) = ct
p_tl = 0
For i = 1 To ct
p_tl = p_tl + Cells(i + 1, 5)
Next i
Cells(ct + 3, 5) = p_tl
Cells(1, 6) = "accumulative"
Cells(ct + 3, 6) = 0
For i = 1 To ct
Cells(ct + 3, 6) = Cells(ct + 3, 6) + Cells(i + 1, 5)
Cells(i + 1, 6) = Format(Cells(ct + 3, 6) / p_tl, "0.00%")
Next i
Cells(ct + 3, 6) = ""
‘----------------------------------------------------------------
‘ --------------------Copy 截止處 -------------------------
4 新增一個按鈕來執行巨集 pareto
5 測試
5-1 用第1講數據結果如表3
5-2 測試無其他項 將else 項目不良設為0
5-3 自行增加不良內容，注意其他項必須放在最後
<第3講 完>