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
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