Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, text
For i = 1 To Target.Count
text = Target.Item(i).text
y = Target.Item(i).Column
x = Target.Item(i).Row
If text = "" Or x = 1 Then Exit Sub '为空 或 第一行 跳过
Select Case Cells(1, y).Value '根据修改所在列 表头名 校验数据有效性
Case "会员号"
If RegExpTest(text, "^[a-zA-Z][a-zA-Z\d]{3,10}$") = False Then
Cells(x, y).Select
MsgBox "【" & Cells(1, y).Value & "】 第" & x & "行：" & text & vbCrLf & "会员号必须字母开头，长度为4~11位。", 48, "数据输入有误"
Cells(x, y).Value = ""
End If
Case "姓名"
If RegExpTest(text, "^[\u4e00-\u9fa5]{2,4}$") = False Then
Cells(x, y).Select
MsgBox "【" & Cells(1, y).Value & "】 第" & x & "行：" & text & vbCrLf & "姓名必须为中文2~4位。", 48, "数据输入有误"
Cells(x, y).Value = ""
End If
Case "手机"
If RegExpTest(text, "^1\d{10}$") = False Then
Cells(x, y).Select
MsgBox "【" & Cells(1, y).Value & "】 第" & x & "行：" & text & vbCrLf & "非法手机号", 48, "数据输入有误"
Cells(x, y).Value = ""
End If
Case "客户QQ"
If RegExpTest(text, "^[1-9]\d{4,10}$") = False Then
Cells(x, y).Select
MsgBox "【" & Cells(1, y).Value & "】 第" & x & "行：" & text & vbCrLf & "非法QQ号", 48, "数据输入有误"
Cells(x, y).Value = ""
End If
Case "邮箱"
If RegExpTest(text, "^([a-zA-Z0-9]+[_|\-|\.]?)*[a-zA-Z0-9]+@([a-zA-Z0-9]+[_|\-|\.]?)*[a-zA-Z0-9]+\.[a-zA-Z]{2,4}$") = False Then
Cells(x, y).Select
MsgBox "【" & Cells(1, y).Value & "】 第" & x & "行：" & text & vbCrLf & "非法邮箱", 48, "数据输入有误"
Cells(x, y).Value = ""
End If
End Select
Next
End Sub
Private Function RegExpTest(StrText, Pattern) '
Dim regex
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = Pattern
regex.IgnoreCase = True
regex.Global = True
RegExpTest = regex.Test(StrText)
Set regex = Nothing
End Function
