用EXCEl在處理成績的時候，需要一些功能，可是EXCEL沒有內建，例如
下面這個檔案下載開啟之後，選擇開啟巨集，EXCEL就會自動會增加一個工具列，叫做[AChien-bar]，而關閉這個檔案之後，這個工具列會隨之消失
http://sites.google.com/site/pancala/Home/AChien-bar.xls
為了作範例，所以我用中文姓名產生器做了一些假姓名來示範
紅色圈圈的部份就是[AChien-Bar]，而這個工作表的內容就是全年級的生物成績
首先介紹分組的功能。
作盒狀圖或是作統計分析時，需要將全年級的名單，分解成各班一欄的樣子。
這個分組的功能是處理原有名單裡的第一欄和第二欄資料
上面的資料按下分組之後，就會產生一個新的資料表，像下面這樣。
如果是要作盒狀圖，就要把上面的成績放在第二欄
再來介紹分頁的功能，按下去之後，它會用A2儲存格以下的格子去作比較，格子裡的資料如果不一樣，就會加上一條分頁線
最後一個是畫線的功能，我要把701的這十位同學，每五位的底下畫一條線，就先圈選範圍，然後按下畫線。
最後就是這樣，我預設是畫紅線
裡頭主要的程式是
另外，新增工具列的方式，我在YDM 生活學習誌學到了，在ThisWorkbooku加了
- 把全年級的名單，分解成像名條一樣，一個縱欄一個班級
- 把全年級的名單，各班間自動插入分頁線，這樣印出來才會一班在一張
- 每五個人的資料畫一條線，彼此區隔
下面這個檔案下載開啟之後，選擇開啟巨集，EXCEL就會自動會增加一個工具列，叫做[AChien-bar]，而關閉這個檔案之後，這個工具列會隨之消失
http://sites.google.com/site/pancala/Home/AChien-bar.xls
為了作範例，所以我用中文姓名產生器做了一些假姓名來示範
紅色圈圈的部份就是[AChien-Bar]，而這個工作表的內容就是全年級的生物成績
首先介紹分組的功能。
作盒狀圖或是作統計分析時，需要將全年級的名單，分解成各班一欄的樣子。
這個分組的功能是處理原有名單裡的第一欄和第二欄資料
上面的資料按下分組之後，就會產生一個新的資料表，像下面這樣。
如果是要作盒狀圖，就要把上面的成績放在第二欄
再來介紹分頁的功能，按下去之後，它會用A2儲存格以下的格子去作比較，格子裡的資料如果不一樣，就會加上一條分頁線
最後一個是畫線的功能，我要把701的這十位同學，每五位的底下畫一條線，就先圈選範圍，然後按下畫線。
最後就是這樣，我預設是畫紅線
裡頭主要的程式是
'說明:插入分頁線
Sub PageBreak()
ActiveSheet.ResetAllPageBreaks
totolrow = Range("A1").End(xlDown).Row
x = Cells(2, 1)
For i = 2 To totolrow
If Cells(i, 1) <> x Then
ActiveSheet.HPageBreaks.Add Before:=Cells(i, 1)
x = Cells(i + 1, 1)
End If
Next
End Sub
'說明:分組轉換
Sub TransferScore()
oldname = ActiveSheet.Name
newname = ActiveSheet.Name & "_" & Worksheets.Count
'新增工作表
Worksheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = newname
stunum = Worksheets(oldname).Range("A1").End(xlDown).Row
x = Worksheets(oldname).Range("A1").Value
Worksheets(newname).Cells(1, 1) = "tmp"
Worksheets(newname).Cells(2, 1) = x
newsheetCol = 1
'加標題
For i = 1 To stunum
If Worksheets(oldname).Cells(i, 1) <> x Then
x = Worksheets(oldname).Cells(i, 1)
newsheetCol = newsheetCol + 1
Worksheets(newname).Cells(1, newsheetCol) = "tmp"
Worksheets(newname).Cells(2, newsheetCol) = x
End If
Next
'加其他
For i = 1 To stunum
For j = 1 To newsheetCol
If Worksheets(newname).Cells(2, j) = Worksheets(oldname).Cells(i, 1) Then
newRow = Worksheets(newname).Cells(1, j).End(xlDown).Row + 1
Worksheets(newname).Cells(newRow, j) = Worksheets(oldname).Cells(i, 2)
End If
Next
Next
Worksheets(newname).Rows("1:1").Delete Shift:=xlUp
End Sub
'說明:五欄線
Sub rangeBorder()
upRange = Selection.Row
downRange = Selection.Row + Selection.Rows.Count - 1
leftRange = Selection.Column
rightRange = Selection.Column + Selection.Columns.Count - 1
For i = 1 To Int(Selection.Rows.Count / 5)
newRow = upRange + i * 5 - 1
With Range(Cells(newRow, leftRange), Cells(newRow, rightRange)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Next
End Sub
另外，新增工具列的方式，我在YDM 生活學習誌學到了，在ThisWorkbooku加了
Private Sub Workbook_Open()
Dim myNewBar As CommandBar '宣告工具列物件
'宣告工具列按鈕物件
Dim myButton1 As CommandBarButton '分組
Dim myButton2 As CommandBarButton '分頁
Dim myButton3 As CommandBarButton '五欄畫線
Set myNewBar = Application.CommandBars.Add '新增一個工具列
myNewBar.Name = "AChien-Bar" '工具列命名
With myNewBar
Set myButton1 = .Controls.Add(msoControlButton)
With myButton1
.Style = msoButtonCaption '只顯示文字 底下這3種型式選一種
'.Style = msoButtonIcon '只顯示小圖示
'.Style = msoButtonIconAndCaption msoComboLabel '同時顯示文字和小圖示
.BeginGroup = True
.Caption = "分組" '顯示在工具列上的按鈕文字
.TooltipText = "分組" '滑鼠移過去時，所顯示的提示文字
.FaceId = 9 '小圖示
.Tag = "MyCustomTag"
.OnAction = "TransferScore" '設定按下此鍵時所要執行的巨集
End With
.Position = msoBarTop '工具列擺放在上層
.Visible = True
Set myButton2 = .Controls.Add(msoControlButton)
With myButton2
.Style = msoButtonCaption '只顯示文字 底下這3種型式選一種
'.Style = msoButtonIcon '只顯示小圖示
'.Style = msoButtonIconAndCaption msoComboLabel '同時顯示文字和小圖示
.BeginGroup = True
.Caption = "分頁" '顯示在工具列上的按鈕文字
.TooltipText = "分頁" '滑鼠移過去時，所顯示的提示文字
.FaceId = 9 '小圖示
.Tag = "MyCustomTag"
.OnAction = "PageBreak" '設定按下此鍵時所要執行的巨集
End With
Set myButton3 = .Controls.Add(msoControlButton)
With myButton3
.Style = msoButtonCaption '只顯示文字 底下這3種型式選一種
'.Style = msoButtonIcon '只顯示小圖示
'.Style = msoButtonIconAndCaption msoComboLabel '同時顯示文字和小圖示
.BeginGroup = True
.Caption = "畫線" '顯示在工具列上的按鈕文字
.TooltipText = "畫線" '滑鼠移過去時，所顯示的提示文字
.FaceId = 9 '小圖示
.Tag = "MyCustomTag"
.OnAction = "rangeBorder" '設定按下此鍵時所要執行的巨集
End With
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("AChien-Bar").Delete
End Sub
