以下是好用的格式檢查函數，不管Excel中的儲存格定義為什麼型態的，
都可以檢查出內容型態是否合規定。
可以檢查內容是否為：
D:日期,
C:字串,
NI:整數,
NIP:正整數(包含0),
NFP:正浮點數(包含0),
NIP_NFP:正整數及正浮點數
以下是程式碼，有經過測試可以正常使用。
Rem <summary>
Rem 檢查某儲存格內容的型態及長度是否正確
Rem <param name="tcSheetName">Sheet名稱</param>
Rem <param name="tnRowNo">儲存格列號</param>
Rem <param name="tnColumnNo">儲存格行號</param>
Rem <param name="tcType">指定型態(D:日期, C:字串, NI:整數, NIP:正整數(包含0), NFP:正浮點數(包含0), NIP_NFP:正整數及正浮點數)</param>
Rem <param name="tnLength">選擇性參數，如型態為『C:字串』，必須指定長度</param>
Rem <param name="tcCompareKind">選擇性參數，如型態為『C:字串』，必須指定比較方式("<=":小於等於,"<":小於)
Rem <returns>True:通過檢查，False:未通過檢查</returns>
Public Function checkTypeAndLength_Cell(tcSheetName As String, _
tnRowNo As Integer, _
tnColumnNo As Integer, _
tcType As String, _
Optional tnLength As Integer, _
Optional tcCompareKind As String)
'宣告變數,給定初值
Dim lnChrAscCode As Integer
Dim lcCellType As String
Dim lcStrCType As String
Dim lnI As Integer
Dim lnCount As Integer
Dim lcTempStr As String
Dim lnRet As Integer
Dim lnRet1 As Integer
Dim lnRet2 As Integer
Dim lnRet3 As Integer
Dim lnRet4 As Integer
Dim lbHave_Eng As Boolean
Dim lbHave_Mark As Boolean
Dim lbHave_Cht As Boolean
Dim lbHave_HeaderPos As Boolean
Dim lbHave_HeaderNeg As Boolean
Dim lnSignCount As Integer
Dim lcStr As String
Dim lnPeriodCount As Integer
Dim lnPeriodPosition As Integer
Dim lnSlashPosition1 As Integer
Dim lnSlashPosition2 As Integer
Dim lcYYYY As String
Dim lcMM As String
Dim lcDD As String
lnChrAscCode = 0 '儲存單字元的AscII碼
lcCellType = "" '儲存格內容型態判定結果(日期, 字串, 正數, 負數, 整數, 浮點數)
lcStrCType = "" '儲存格中單字元的型態判斷結果 (數字,英文,符號,句點,中文,加號,減號)
lnI = 0 '檢查字串使用的Index
lnCount = 0 '一般計數器
lnRet = 0
lnRet1 = 0
lnRet2 = 0
lnRet3 = 0
lnRet4 = 0
'檢查內容值是否為空白
If IsEmpty(Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo)) Then
lcCellType = "空白,"
'檢查內容值是否為數值
ElseIf IsNumeric(Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo)) Then
If (Int(Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo)) = _
CDbl(Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo))) Then
lcCellType = lcCellType + "整數,"
Else
lcCellType = lcCellType + "浮點數,"
End If
If (Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo) >= 0) Then
lcCellType = lcCellType + "正數,"
Else
lcCellType = lcCellType + "負數,"
End If
'檢查內容值是否為日期
ElseIf IsDate(Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo)) Then
lcCellType = "日期,"
Else
'取得儲存格內容並將其左右空白刪除
lcStr = ""
lcStr = Trim(Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo))
'判斷儲存格內容中每個字元的型態
For lnI = 1 To Len(lcStr)
lnChrAscCode = AscW(Mid(lcStr, lnI))
Select Case lnChrAscCode
Case 48 To 57
lcStrCType = lcStrCType + "數字,"
Case 65 To 90, 97 To 122
lcStrCType = lcStrCType + "英文,"
Case 43
lcStrCType = lcStrCType + "加號,"
Case 45
lcStrCType = lcStrCType + "減號,"
Case 0 To 42, 44, 47, 58 To 64, 91 To 96, 122 To 255
lcStrCType = lcStrCType + "符號,"
Case 46
lcStrCType = lcStrCType + "句點,"
Case Else
lcStrCType = lcStrCType + "中文,"
End Select
Next lnI
'進行字串內容檢查
'有沒有英文?
lbHave_Eng = False
lbHave_Eng = InStr(1, lcStrCType, "英文")
'有沒有符號?
lbHave_Mark = False
lbHave_Mark = InStr(1, lcStrCType, "符號")
'有沒有中文?
lbHave_Cht = False
lbHave_Cht = InStr(1, lcStrCType, "中文")
'開頭是否為'+'或'-'?
'找尋字串中是否有','
lnCount = 0
lnCount = InStr(1, lcStrCType, ",", 1)
'如果有逗號則取出第一個逗號前的字串
lcTempStr = ""
If lnCount > 0 Then
lcTempStr = Mid(lcStrCType, 1, lnCount - 1)
Else '如果沒有逗號則取出整個字串
lcTempStr = lcStrCType
End If
'檢查該字串是否等於"加號" 或 等於 "減號"
lbHave_HeaderPos = False
If lcTempStr = "加號" Then
lbHave_HeaderPos = True
Else
lbHave_HeaderPos = False
End If
lbHave_HeaderNeg = False
If lcTempStr = "減號" Then
lbHave_HeaderNeg = True
Else
lbHave_HeaderNeg = False
End If
'加號及減號的數量
lnSignCount = 0
lnSignCount = strCount(lcStr, "+") + _
strCount(lcStr, "-")
'進行型態判定
'是否為數值? (不能有英文，不能有符號，不能有中文)
If (lbHave_Eng = False And _
lbHave_Mark = False And _
lbHave_Cht = False) Then
'句點數量?
lnPeriodCount = strCount(lcStr, ".")
'整數,句點數量為0
If (lnPeriodCount = 0) Then
'如果正負號數量為0,則為整數
If (lnSignCount = 0) Then
lcCellType = lcCellType + "整數,"
'如果正負號總數量為1,且有正負號在開頭,則為整數
ElseIf (lnSignCount = 1 And (lbHave_HeaderPos = True Or lbHave_HeaderNeg = True)) Then
lcCellType = lcCellType + "整數,"
End If
'浮點數，句點數量必須為1個
ElseIf lnPeriodCount = 1 Then
'取得句點的位置
lnPeriodPosition = 0
lnPeriodPosition = InStr(1, lcStr, ".")
'當第一個位置不為正負號時，句點不能在開頭
If ((lbHave_Mark = False And lbHave_Cht = False) And lnPeriodPosition <> 1) Then
lcCellType = lcCellType + "浮點數,"
'當第一個位置為正負號時，句點不能在第二位
ElseIf (lnPeriodPosition <> 2) Then
lcCellType = lcCellType + "浮點數,"
End If
End If
'正數或負數?
If (lbHave_HeaderPos = True) Then
lcCellType = lcCellType + "正數,"
ElseIf (lbHave_HeaderNeg = True) Then
lcCellType = lcCellType + "負數,"
Else
lcCellType = lcCellType + "正數,"
End If
Else
'日期:強迫必須符合為'YYYY/MM/DD'如符合此格式的為日期
lcStr = Trim(lcStr)
'取得斜線符號所在位置,
lnSlashPosition1 = InStr(1, lcStr, "/")
If lnSlashPosition1 > 0 Then
lcYYYY = Mid(lcStr, 1, lnSlashPosition1 - 1)
lnSlashPosition2 = InStr(lnSlashPosition1 + 1, lcStr, "/")
If lnSlashPosition2 > 0 Then
lcMM = Mid(lcStr, lnSlashPosition1 + 1, lnSlashPosition2 - 1)
lcDD = Mid(lcStr, lnSlashPosition2 + 1, Len(lcStr) - lnSlashPosition2)
If (Val(lcYYYY) > 0) And (Val(lcMM) > 0) And _
(Val(lcMM) < 13) And (Val(lcDD) > 0) And _
(Val(lcDD) < 32) Then
lcCellType = lcCellType + "日期,"
End If
End If
End If
End If
'如都不符合以上條件,為字串型態
If Trim(lcCellType) = "" Then
lcCellType = "字串"
End If
End If
'去掉字串最後面的逗點
If Mid(lcCellType, Len(lcCellType), 1) = "," Then
lcCellType = Mid(lcCellType, 1, Len(lcCellType) - 1)
End If
'如果為空白，則不做型態檢查，直接By Pass
If lcCellType = "空白" Then
checkTypeAndLength_Cell = True
Exit Function
End If
'依設定的資料型態對儲存格內容進行型態判斷
lnRet = 0
lnRet1 = 0
lnRet2 = 0
lnRet3 = 0
lnRet4 = 0
Select Case tcType
Case "C": '字串
lnRet = InStr(1, lcCellType, "字串")
If lnRet > 0 Then
Select Case tcCompareKind
Case "<=" '小於等於
If Len(lcStr) > tnLength Then
checkTypeAndLength_Cell = False
Exit Function
End If
Case "=" '等於
If Len(lcStr) <> tnLength Then
checkTypeAndLength_Cell = False
Exit Function
End If
End Select
Else
checkTypeAndLength_Cell = False
Exit Function
End If
Case "D": '日期
lnRet = InStr(1, lcCellType, "日期")
If lnRet = 0 Then
'Worksheets(tcSheetName).Activate
'Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo).Select
' MsgBox "第" & CStr(tnRowNo) & "列" & "第" & CStr(tnColumnNo) & "行" & _
' "必須為日期! 請修正!"
checkTypeAndLength_Cell = False
Exit Function
End If
Case "NI": '整數
lnRet = InStr(1, lcCellType, "整數")
If lnRet = 0 Then
'Worksheets(tcSheetName).Activate
'Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo).Select
'MsgBox "第" & CStr(tnRowNo) & "列" & "第" & CStr(tnColumnNo) & "行" & _
' "必須為字串! 請修正!"
checkTypeAndLength_Cell = False
Exit Function
End If
Case "NIP": '正整數 (包含0)
lnRet1 = InStr(1, lcCellType, "整數")
lnRet2 = InStr(1, lcCellType, "正數")
If (lnRet1 = 0 Or lnRet2 = 0) Then
'Worksheets(tcSheetName).Activate
'Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo).Select
'MsgBox "第" & CStr(tnRowNo) & "列" & "第" & CStr(tnColumnNo) & "行" & _
' "必須為正整數! 請修正!"
checkTypeAndLength_Cell = False
Exit Function
End If
Case "NFP": '正浮點數 (包含0)
lnRet1 = InStr(1, lcCellType, "浮點數")
lnRet2 = InStr(1, lcCellType, "正數")
If (lnRet1 = 0 Or lnRet2 = 0) Then
'Worksheets(tcSheetName).Activate
'Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo).Select
'MsgBox "第" & CStr(tnRowNo) & "列" & "第" & CStr(tnColumnNo) & "行" & _
' "必須為正浮點數! 請修正!"
checkTypeAndLength_Cell = False
Exit Function
End If
Case "NIP_NFP": '正整數或正浮點數 (包含0)
lnRet1 = InStr(1, lcCellType, "整數")
lnRet2 = InStr(1, lcCellType, "正數")
lnRet3 = InStr(1, lcCellType, "浮點數")
lnRet4 = InStr(1, lcCellType, "正數")
If (lnRet1 = 0 Or lnRet2 = 0) And (lnRet3 = 0 Or lnRet4 = 0) Then
'Worksheets(tcSheetName).Activate
'Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo).Select
'MsgBox "第" & CStr(tnRowNo) & "列" & "第" & CStr(tnColumnNo) & "行" & _
' "必須為正浮點數! 請修正!"
checkTypeAndLength_Cell = False
Exit Function
End If
Case Else '沒有指定正確的資料型態，將會出現此狀況!需要修正程式
'Worksheets(tcSheetName).Activate
'Worksheets(tcSheetName).Cells(tnRowNo, tnColumnNo).Select
'MsgBox "第" & CStr(tnRowNo) & "列" & "第" & CStr(tnColumnNo) & "行" & _
' "VBA程式中未指明資料型態! 請修正程式!"
checkTypeAndLength_Cell = False
Exit Function
End Select
'通過檢查
checkTypeAndLength_Cell = True
End Function
