EXCEL 保存以前校驗

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'MsgBox "開始檢測數據..."
'數據不合法就不容許保存
Dim isCancel As Boolean
'定義已填寫的數據行數
Dim length As Integer
'存放各列行數，選擇最大的值
Dim cellArray As Variant
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim f As Integer
Dim g As Integer
Dim h As Integer
Dim i As Integer
Dim j As Integer
a = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row
b = ThisWorkbook.Sheets(1).Range("b65536").End(xlUp).Row
c = ThisWorkbook.Sheets(1).Range("c65536").End(xlUp).Row
d = ThisWorkbook.Sheets(1).Range("d65536").End(xlUp).Row
e = ThisWorkbook.Sheets(1).Range("e65536").End(xlUp).Row
f = ThisWorkbook.Sheets(1).Range("f65536").End(xlUp).Row
g = ThisWorkbook.Sheets(1).Range("g65536").End(xlUp).Row
h = ThisWorkbook.Sheets(1).Range("h65536").End(xlUp).Row
i = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
cellArray = Array(a, b, c, d, e, f, g, h, i)
length = Excel.Application.WorksheetFunction.Max(cellArray)

'校驗每行數據是否合法
For i = 2 To length
'前5列不能爲空
If Worksheets("Sheet1").Range("A" & i).Value = "" Then
Worksheets("Sheet1").Range("A" & i).Select
MsgBox "第" & i & "行【網點全稱】列：內容不容許爲空"
isCancel = True
Exit For
End If

If Worksheets("Sheet1").Range("B" & i).Value = "" Then
Worksheets("Sheet1").Range("B" & i).Select
MsgBox "第" & i & "行【網點簡稱】列：內容不容許爲空"
isCancel = True
Exit For
End If

If Worksheets("Sheet1").Range("C" & i).Value = "" Then
Worksheets("Sheet1").Range("C" & i).Select
MsgBox "第" & i & "行【網點類型】列：內容不容許爲空"
isCancel = True
Exit For
End If

If Worksheets("Sheet1").Range("D" & i).Value = "" Then
Worksheets("Sheet1").Range("D" & i).Select
MsgBox "第" & i & "行【上級機構代碼】列：內容不容許爲空"
isCancel = True
Exit For
End If

'檢測上級機構類型長度是否爲15位
If Len(Worksheets("Sheet1").Range("D" & i).Value) <> 15 Then
Worksheets("Sheet1").Range("D" & i).Select
MsgBox "第" & i & "行【上級機構代碼】列：長度必須爲15"
isCancel = True
Exit For
End If

If Worksheets("Sheet1").Range("E" & i).Value = "" Then
Worksheets("Sheet1").Range("E" & i).Select
MsgBox "第" & i & "行【網點狀態】列：內容不容許爲空"
isCancel = True
Exit For
End If


Next

'數據不合法就不容許保存
If isCancel Then
Cancel = True
Else
Cancel = False
End If

End Sub

 

 --------------------------

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'MsgBox "開始檢測數據..."
'數據不合法就不容許保存
Dim isCancel As Boolean
'定義已填寫的數據行數
Dim length As Integer
'存放各列行數，選擇最大的值
Dim cellArray As Variant
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim f As Integer
Dim g As Integer
Dim h As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Dim o As Integer
Dim p As Integer
Dim q As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer

a = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row
b = ThisWorkbook.Sheets(1).Range("b65536").End(xlUp).Row
c = ThisWorkbook.Sheets(1).Range("c65536").End(xlUp).Row
d = ThisWorkbook.Sheets(1).Range("d65536").End(xlUp).Row
e = ThisWorkbook.Sheets(1).Range("e65536").End(xlUp).Row
f = ThisWorkbook.Sheets(1).Range("f65536").End(xlUp).Row
g = ThisWorkbook.Sheets(1).Range("g65536").End(xlUp).Row
h = ThisWorkbook.Sheets(1).Range("h65536").End(xlUp).Row
i = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
j = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
k = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
l = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
m = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
n = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
o = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
p = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
q = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
r = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
s = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row
t = ThisWorkbook.Sheets(1).Range("i65536").End(xlUp).Row

cellArray = Array(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
length = Excel.Application.WorksheetFunction.Max(cellArray)

'校驗每行數據是否合法
For i = 2 To length
'ABCDG項不能爲空
If Worksheets("Sheet1").Range("A" & i).Value = "" Then
Worksheets("Sheet1").Range("A" & i).Select
MsgBox "第" & i & "行【商戶代碼】列：內容不容許爲空"
isCancel = True
Exit For
End If

'商戶代碼必須是1-99的數字
If Not bTest(Worksheets("Sheet1").Range("A" & i).Value, "^[0-9]*[1-9][0-9]*$") Then
Worksheets("Sheet1").Range("A" & i).Select
MsgBox "第" & i & "行【商戶代碼】列：必須是1-99的數字"
isCancel = True
Exit For
Else
If Worksheets("Sheet1").Range("A" & i).Value < 1 Or Worksheets("Sheet1").Range("A" & i).Value > 99 Then
Worksheets("Sheet1").Range("A" & i).Select
MsgBox "第" & i & "行【商戶代碼】列：必須是1-99的數字"
isCancel = True
Exit For
End If
End If

If Worksheets("Sheet1").Range("B" & i).Value = "" Then
Worksheets("Sheet1").Range("B" & i).Select
MsgBox "第" & i & "行【商戶全稱】列：內容不容許爲空"
isCancel = True
Exit For
End If

If Worksheets("Sheet1").Range("C" & i).Value = "" Then
Worksheets("Sheet1").Range("C" & i).Select
MsgBox "第" & i & "行【商戶簡稱】列：內容不容許爲空"
isCancel = True
Exit For
End If

If Worksheets("Sheet1").Range("D" & i).Value = "" Then
Worksheets("Sheet1").Range("D" & i).Select
MsgBox "第" & i & "行【商戶類型】列：內容不容許爲空"
isCancel = True
Exit For
End If

If Worksheets("Sheet1").Range("G" & i).Value = "" Then
Worksheets("Sheet1").Range("G" & i).Select
MsgBox "第" & i & "行【商戶狀態】列：內容不容許爲空"
isCancel = True
Exit For
End If


'EF兩項不能同時爲空
If Worksheets("Sheet1").Range("E" & i).Value = "" And Worksheets("Sheet1").Range("F" & i).Value = "" Then
Worksheets("Sheet1").Range("E" & i).Select
MsgBox "第" & i & "行【單用途卡上級單位】列和【多用途卡上級單位】：不能同時爲空"
isCancel = True
Exit For
End If

'最大退貨次數只能爲0或正整數
If Worksheets("Sheet1").Range("H" & i).Value <> "" And (Not bTest(Worksheets("Sheet1").Range("H" & i).Value, "^(0|[1-9]\d*)$")) Then
Worksheets("Sheet1").Range("H" & i).Select
MsgBox "第" & i & "行【最大退貨次數】列：只能爲0或正整數"
isCancel = True
Exit For
End If

'校驗郵箱
If Worksheets("Sheet1").Range("T" & i).Value <> "" And (Not bTest(Worksheets("Sheet1").Range("T" & i).Value, "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*")) Then
Worksheets("Sheet1").Range("T" & i).Select
MsgBox "第" & i & "行【財務聯繫人Email】列：郵箱不合法"
isCancel = True
Exit For
End If


Next

'數據不合法就不容許保存
If isCancel Then
Cancel = True
Else
Cancel = False
End If

End Sub

'正則表達式
Function bTest(ByVal s As String, ByVal p As String) As Boolean
Dim re As RegExp
Set re = New RegExp
re.IgnoreCase = False '設置是否匹配大小寫
re.Pattern = p
bTest = re.Test(s)
End Function