再一次

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