2010年12月1日星期三

再一次

Sub 流水號()




Columns("A:A").Select

Selection.Insert Shift:=xlToRight

Range("A1").Select

ActiveCell.FormulaR1C1 = "no"

Range("A2").Select

ActiveCell.FormulaR1C1 = "1"

Range("A2").Select

Selection.AutoFill Destination:=Range("A2:A246"), Type:=xlFillSeries

Range("A2:A246").Select

Range("N2").Select

End Sub

Sub 排序()



Range("A1:U246").Sort Key1:=Range("N2"), Order1:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

SortMethod:=xlStroke, DataOption1:=xlSortNormal

End Sub

Sub 新工作表()

Dim x, sht_name

Sheets(Sheets.Count).Select

Range("N2").Select



While (ActiveCell.Value <> Empty)

If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then



ActiveCell.Offset(1, 0).Select



Else



sht_name = ActiveCell.Value

ActiveCell.Offset(1, 0).Select



Sheets.Add

x = Sheets.Count - 1

Sheets(x).Name = sht_name

Sheets(Sheets.Count).Select



End If



Wend





End Sub



Sub 資料比對()

Dim x



Sheets(Sheets.Count).Select

Range("A1").Select



For i = 1 To Sheets.Count - 1



x = Sheets(i).Name

Selection.AutoFilter

Selection.AutoFilter Field:=14, Criteria1:=x

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

Selection.Copy

新檔



ActiveSheet.Paste

Application.CutCopyMode = False



存檔

關檔





Sheets(Sheets.Count).Select

Range("A1").Select

Selection.AutoFilter



Next

End Sub



Sub 資料分類()

流水號

排序

新工作表

資料比對

刪除工作表

End Sub

Sub 新檔()



Workbooks.Add

End Sub

Sub 存檔()

Dim x



x = Range("N2").Value



ActiveWorkbook.SaveAs Filename:=x & ".xls", FileFormat:=xlNormal, _

Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

CreateBackup:=False

End Sub

Sub 關檔()





ActiveWindow.Close

End Sub

Sub 刪除工作表()

Dim x, i

i = Sheets.Count



For x = 1 To i - 1



Sheets(x).Select

ActiveWindow.SelectedSheets.Delete



Next

End Sub

快速分類

Sub 流水號()




Columns("A:A").Select

Selection.Insert Shift:=xlToRight

Range("A1").Select

ActiveCell.FormulaR1C1 = "no"

Range("A2").Select

ActiveCell.FormulaR1C1 = "1"

Range("A2").Select

Selection.AutoFill Destination:=Range("A2:A246"), Type:=xlFillSeries

Range("A2:A246").Select

Range("N2").Select

End Sub

Sub 排序()



Range("A1:U246").Sort Key1:=Range("N2"), Order1:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

SortMethod:=xlStroke, DataOption1:=xlSortNormal

End Sub

Sub 新工作表()

Dim x, sht_name

Sheets(Sheets.Count).Select

Range("N2").Select



While (ActiveCell.Value <> Empty)

If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then



ActiveCell.Offset(1, 0).Select



Else



sht_name = ActiveCell.Value

ActiveCell.Offset(1, 0).Select



Sheets.Add

x = Sheets.Count - 1

Sheets(x).Name = sht_name

Sheets(Sheets.Count).Select



End If



Wend





End Sub



Sub 資料比對()

Dim x



Sheets(Sheets.Count).Select

Range("A1").Select



For i = 1 To Sheets.Count - 1



x = Sheets(i).Name

Selection.AutoFilter

Selection.AutoFilter Field:=14, Criteria1:=x

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

Selection.Copy

Sheets(x).Select

ActiveSheet.Paste

Application.CutCopyMode = False

Sheets(Sheets.Count).Select

Range("A1").Select

Selection.AutoFilter



Next

End Sub



Sub 資料分類()

流水號

排序

新工作表

資料比對

End Sub

2010年11月30日星期二

大家

各位好,



教育部推動的產業碩士專班100年度春季班, 世新大學即將於11/30~12/6 報名.



麻煩各位協助轉寄給同事及朋友們, 並鼓勵他們前來報考.



相關基本資料說明



1. 報名日期: 2010/11/30~2010/12/6



2. 筆試及口試日期: 2010/12/25(資訊軟體班), 2010/12/26(數位內容班)



3. 放榜: 2011/01/07



4. 修業期間: 2011/02/01~2012/07/31 共1年6個月



5. 學雜費: 每學期5萬元整



p.s. 簡章連結網址: http://www.shu.edu.tw/bbs/AnnounceDetail1.aspx?sID=7197

 
妹咕數位學園歡迎網友們來信指教 妹咕信箱