VBA-好用的資料型態檢查函數

以下是好用的格式檢查函數，不管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

VBA-RANGE物件重點

預先定義一個RANGE變數，方便以下表達。

Dim R as Range

以下記錄有關VBA中RANGE的重要屬性及用法.

* R.Row　'代表該Range中最左上角儲存格，對應到其所屬Sheet中的儲存格列號(如：1,2,3,...)

* R.Column '代表該Range中最左上角儲存格，對應到其所屬Sheet中的儲存格之行(欄)號

   (如：A,B,C,...)

* R.Rows.Count  '代表該Range列的數量

* R.Columns.Count  '代表該Range行的數量

VBA-檢查某欄位所有儲存格內容是否含有空白

Rem <summary>
Rem 檢查某欄位所有儲存格內容是否含有空白
Rem <param name="toDealColumn">目前游標所在欄位(Range物件)(例:Sheet1.Range("A:A"))</param>
Rem <param name="tnColumnCount">本Sheet包含的欄位數量</param>
Rem <returns>True:通過檢查,False:未通過檢查</returns>
Rem </summary>
Public Function checkColumnBlank(toDealColumn As Range, tnColumnCount As Integer) As Boolean

    '尋找toDealColumn對應之工作表的最後一個含有內容(非空白也非Null)的列號
    Dim lnLastUsedRow As Integer
       
        '先撈出整個工作表曾經被使用過區域的最後一列編號
        lnLastUsedRow = Worksheets(toDealColumn.Worksheet.Name).UsedRange.Row + _
                        Worksheets(toDealColumn.Worksheet.Name).UsedRange.Rows.Count - 1
                   
        '找尋每個欄位在工作表中曾經被使用過區域中最後一列之前最後一個含有內容(非空白也非Null)的列編號集合,取此集合之最大值
        Dim lnI As Integer
        Dim lnMaxRowNo As Integer '每個欄位在工作表中曾經被使用過區域中最後一列之前最後一個含有內容(非空白也非Null)的列編號集合之最大值
        Dim lnRowNo As Integer
        lnMaxRowNo = 0
        For lnI = 1 To tnColumnCount
       
            '取得每個欄位由第一列到『整個工作表曾經被使用過區域的最後一列(再加1)的編號』的Range
            Set loDealColumnSubSet = _
                Range(Worksheets(toDealColumn.Worksheet.Name).Cells(toDealColumn.Row, lnI), _
                      Worksheets(toDealColumn.Worksheet.Name).Cells(lnLastUsedRow + 1, lnI))
           
            '在此Range中找到本欄最後一個含有內容(非空白也非Null)的儲存格
            'Set result = loDealColumnSubSet.Find(What:=Null, After:=loDealColumnSubSet.Rows(lnLastUsedRow), _
            '                                     SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
           
            '尋找此Range最後一個含有內容的Cell
            lnRowNo = 0
            lnRowNo = toDealColumn.Row + loDealColumnSubSet.Cells(loDealColumnSubSet.Rows.Count, 1) _
                      .End(xlUp).Row - 1
           
            '如果有找到內容非空白也非Null的儲存格式,取得此儲存格的列編號
            'If Not result Is Nothing Then
            '    lnRowNo = result.Row
            'Else
            '    lnRowNo = 0
            'End If
           
            '記錄列編號集合之最大值
            If lnRowNo > lnMaxRowNo Then
                lnMaxRowNo = lnRowNo
            End If
        Next lnI
                               
    '取得指定欄位第一列到第lnMaxRowNo列的Range
    Set loDealColumnSubSet = _
        Range(Worksheets(toDealColumn.Worksheet.Name).Cells(toDealColumn.Row, toDealColumn.Column), _
              Worksheets(toDealColumn.Worksheet.Name).Cells(lnMaxRowNo, toDealColumn.Column))
             
    '在此Range中由最後一列向上尋找為Null的儲存格
    Set result = loDealColumnSubSet.Find(What:=Null, After:=loDealColumnSubSet.Rows(lnMaxRowNo), _
                                         SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
                               
    '如果找到了Null的儲存格,提示User並跳到該儲存格
    If result Is Nothing Then
    Else
        Worksheets(toDealColumn.Worksheet.Name).Activate
        result.Select
        MsgBox "第" & result.Row & "列" & "第" & result.Column & "行" & _
               "不可為空白! 請修正!"
        checkColumnBlank = False
        Exit Function
    End If
   
    '驗證通過,未包含空白
    checkColumnBlank = True

End Function

VBA-將所有沒有內容的儲存格中的『空白』刪除

Rem <summary>
Rem 將所有沒有內容的儲存格中的『空白』刪除
Rem <param name="tcSheetName">Sheet名稱</param>
Rem <returns>True:通過檢查,False:未通過檢查</returns>
Function clearCellBlank(tcSheetName As String) As Boolean

    '取得指定Sheet己使用的區域
    Dim myRange As Range
    Set myRange = Worksheets(tcSheetName).UsedRange
         
    '刪除曾經有被使用過的區域中只有『空白』的儲存格
    Dim lnI As Integer
    Dim lnJ As Integer
    Dim lnStartRow As Integer
    Dim lnStartColumn As Integer
    Dim lnRowCount As Integer
    Dim lnColumnCount As Integer
 
    lnStartRow = myRange.Row '曾經有被使用過的區域的第一列
    lnStartColumn = myRange.Column '曾經有被使用過的區域的第一欄
    lnRowCount = myRange.Rows.Count '曾經有被使用過的區域的列數量
    lnColumnCount = myRange.Columns.Count '曾經有被使用過的區域的行數量
 
    For lnI = 0 To lnRowCount - 1
        For lnJ = 0 To lnColumnCount - 1
     
            '如果儲存格為空白,則將空白去除,改為Null
            If (Trim(Worksheets(tcSheetName).Cells(lnStartRow + lnI, lnStartColumn + lnJ)) = "") And _
               (Not IsNull(Worksheets(tcSheetName).Cells(lnStartRow + lnI, lnStartColumn + lnJ))) Then
             
                Worksheets(tcSheetName).Cells(lnStartRow + lnI, lnStartColumn + lnJ) = Null
         
            End If
         
        Next lnJ
    Next lnI

End Function

VBA-檢查是否有在在原本定義欄位之外的欄位輸入資料

Rem <summary>
Rem 檢查是否有在在原本定義欄位之外的欄位輸入資料
Rem <param name="tcSheetName">Sheet名稱</param>
Rem <param name="tnColumnCount">原先定義欄位數量</param>
Rem <returns>True:通過檢查,False:未通過檢查</returns>
Function checkExceedInput(tcSheetName As String, tnColumnCount) As Boolean

    '取得指定Sheet曾經己使用的區域
    Dim myRange As Range
    Set myRange = Worksheets(tcSheetName).UsedRange

    '取得指定Sheet曾經己使用的區域的最大欄位編號(絕對位置)
    Dim lnUsedColumnMaxNo As Integer
    lnUsedColumnMaxNo = myRange.Column + myRange.Columns.Count - 1
 
    '取得指定Sheet曾經己使用的區域的最大列數編號(絕對位置)
    Dim lnUsedRowMaxNo As Integer
    lnUsedRowMaxNo = myRange.Row + myRange.Rows.Count - 1
 
    '如果『曾經己使用的區域的最大欄位編號』>『原先定義欄位數量』
    '則檢查超過的欄位中是否有任何資料(都是不合法的!必須報警提示).
    Dim lnI As Integer
    Dim lnRowNo As Integer
    If lnUsedColumnMaxNo > tnColumnCount Then
 
        For lnI = (tnColumnCount + 1) To lnUsedColumnMaxNo
     
            lnRowNo = 0
            lnRowNo = Worksheets(tcSheetName).Cells(lnUsedRowMaxNo + 1, lnI).End(xlUp).Row
         
            If lnRowNo > 1 Then
         
                Worksheets(tcSheetName).Activate
                Worksheets(tcSheetName).Cells(myRange.Row + lnRowNo - 1, myRange.Column + lnI - 1).Select
                MsgBox "第" + CStr(lnRowNo) + "列,第" + CStr(lnI) + "行" + _
                "己超出資料填寫區域，請檢查修正(刪除)後再存檔!"
                checkExceedInput = False
                Exit Function
             
            End If
         
        Next lnI
     
    End If
 
    '通過檢查
    checkExceedInput = True

End Function

VBA-UsedRange特性

* UsedRange 指的是使用到的範圍，就算是使用過再清內容...還是是使用過的!
你應該用 "刪除" 的指令，而不要用 "清空"...應該就可以解決你的問題~試試!

* 改動某欄位寬度(如果該欄中沒有任何儲存格被使用過)，不代表該欄位被使用。

* 改變列高度(如果該列沒有任何欄位有被使用過)，代表該改變列的第一個儲存格被使用。

* 選定某一儲存格，不代表該儲存格被使用。

* 儲存格輸入空白，代表該儲存格被使用。

* Sheet1.UsedRange.SpecialCells(xlLastCell) 代表『曾經被使用過』的儲存格(就算己被清為Null或空白也代表曾經有被使用過,由該檔案開始存在後就開始累計)的區域最右下角那個儲存格 (該儲存格不一定是有被使用的)