VBA_自定義函數

'函數的基本定義01
Function huilv(x as long)
huilv = x / 6.03 - x * 0.03
End Function
Function chenghu(sex as String)
If sex = "男" Then
chenghu = "先生"
Else
chenghu = "女士"
End If
End Function

'日期轉換，截取
Function rqtq(str as String)
rqtq = DateSerial(Left(str, 4), Mid(str, 5, 2), Right(str, 2))
End Function

Function tq(str1 as String)
tq = rqtq(Mid(str1, 7, 8))
End Function

分割

Function fenlie(str, str1 As String, n As Integer)
'split將字符串進行拆分並且存儲--數組，(n-1)相當於數組的下標
fenlie = Split(str, str1)(n - 1)
End Function

'帶參數的過程
Sub createTable(str)
Dim sht As Worksheet
'遍歷所有工作表判斷表名是否重複，如重複進行標識
For Each sht In Sheets
    If sht.Name = str Then
    k = 1
    End If
Next
'在最後一個表插入一個表，並給表命名
If k = 0 Then
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = str
    End If
End Sub
'調用帶參數的過程
Sub main()
Dim inputString
inputString = InputBox("請輸入表名")
Call createTable(inputString)
End Sub

'將表中拆分成單個工作薄並且另存
Sub tableIntoFiles(file As String)
Dim sht As Worksheet
For Each sht In Sheets
    sht.Copy
    ActiveWorkbook.SaveAs Filename:=file & sht.Name & ".xlsx"
    ActiveWorkbook.Close
Next
End Sub
Sub run()
Dim inputString As String
inputString = InputBox("請輸入保存路徑")
Call tableIntoFiles(inputString)
End Sub