Office (OLE) malware analysis — malicious · 1391d3523014d1ff

MALICIOUS

Office (OLE)

218.0 KB Created: 2013-11-20 07:32:48 Authoring application: Microsoft Excel First seen: 2015-09-14

MD5: 0b6c384d805f03a856104259be174377 SHA-1: 6985e1b7336980ee62fa30c87f8c60a820144578 SHA-256: 1391d3523014d1ffc021a489f10ac9688808c4b53a6839da2fa7e5aaaf66d9a6

378 Risk Score

Malware Insights

MITRE ATT&CK

T1059.005 Visual Basic T1566.001 Spearphishing Attachment T1203 Exploitation for Client Execution

The sample is an Excel file containing obfuscated VBA macros designed to execute upon opening. The Workbook_Open macro enables a command bar and the Workbook_BeforeSave macro displays a message box prompting the user to save, which would then trigger further malicious actions. The presence of WScript.Shell usage and CreateObject calls, along with ClamAV detection as a dropper, indicates the macro's intent to download and execute a second-stage payload.

Heuristics 11

ClamAV: Doc.Dropper.Agent-6397370-0 critical CLAMAV_DETECTION

ClamAV detected this file as malware: Doc.Dropper.Agent-6397370-0
VBA macros detected medium 6 related findings OLE_VBA_MACROS

Document contains VBA macro code
WScript.Shell usage critical OLE_VBA_WSCRIPT

WScript.Shell usage
Matched line in script
```
Set OperationRegistry = CreateObject("WScript.Shell")
```
Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADER

Auto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.
Matched line in script
```
Set regEX = CreateObject("VBSCRIPT.REGEXP")
```
CreateObject call high OLE_VBA_CREATEOBJ

CreateObject call
Matched line in script
```
Set regEX = CreateObject("VBSCRIPT.REGEXP")
```
VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC

Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
Workbook_Open macro low OLE_VBA_WBOPEN

Workbook_Open macro
Matched line in script
```
Private Sub Workbook_Open()
```
Auto_Open macro low OLE_VBA_AUTO

Auto_Open macro
Matched line in script
```
Sub auto_open()
```
Reference to Windows Script Host high SC_STR_WSCRIPT

Reference to Windows Script Host
LOLBin token sequence in document text high SE_LOLBIN_RUN_COMMAND

Extracted document text contains a Windows script/execution tool name (PowerShell, mshta, cmd, rundll32, regsvr32, …) within 220 characters of a dangerous flag, command verb, or URL. This is a visible 'run this' instruction in HTML/PDF/RTF lure bodies, or — in macro-laden Office files — the macro's own string-pool entries appearing adjacent in extracted text.
Embedded URL info EMBEDDED_URL

One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.

URL http://3azu.taobao.com In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

Filename Kind Source Size

macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 163979 bytes

Filename	Kind	Source	Size
`macros.bas`	vba-macro	oletools.olevba.extract_macros (decoded VBA source)	163979 bytes
SHA-256: `d92c15a309249515e6a7dbae1d6729eb25116d4faaa5a27fea5d56318448b155`
Preview script First 1,000 lines of the extracted script Attribute VB_Name = "ThisWorkbook" Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Attribute VB_TemplateDerived = False Attribute VB_Customizable = True Private Sub Workbook_BeforeClose(Cancel As Boolean) End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) isSaveButton = MsgBox("您是否确认将要保存该excel，如保存，请点击" & Chr(34) & "确定" & Chr(34) & "," & Chr(10) & "系统将要进行检查校验，如不保存，请点击" & Chr(34) & "取消" & Chr(34) & "?", vbOKCancel) If isSaveButton = vbOK Then 测试所有校验规则并打印错误信息 Else Cancel = True End If End Sub Private Sub Workbook_Open() Application.CommandBars("ply").Enabled = True End Sub Attribute VB_Name = "Sheet1" Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Attribute VB_TemplateDerived = False Attribute VB_Customizable = True Attribute VB_Name = "Sheet2" Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Attribute VB_TemplateDerived = False Attribute VB_Customizable = True Attribute VB_Name = "Sheet3" Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Attribute VB_TemplateDerived = False Attribute VB_Customizable = True Attribute VB_Name = "Sheet4" Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Attribute VB_TemplateDerived = False Attribute VB_Customizable = True Attribute VB_Name = "sheet中过程" Sub Cell_SelectionChange(ByVal Target As Range) Dim titleMsg$, typeValue Dim bsType Dim valEntity Dim val Dim typeRow isFor = False If rgold Is Nothing Then Else rna = ActiveSheet.Range("A65535").End(xlUp).Row cna = ActiveSheet.Range("IV" & startTitle).End(xlToLeft).Column typeValue = ActiveSheet.Cells(1, rgold.Column).value If rgold.Row > rna Or rgold.Column > cna Or (rgold.Row < startTitle + 2 And rgold.Row <> headIndex) Then ElseIf typeValue <> "" Then bsType = Split(typeValue, "-") rowType = Split(typeValue, ":") If UBound(bsType) <> 0 Then For m = LBound(bsType) + 1 To UBound(bsType) valEntity = Split(bsType(m), ":") typeRow = valEntity(0) If rgold.Row = typeRow Then val = Split(valEntity(1), ";") For n = LBound(val) To UBound(val) callFunctionXQ val(n), sheetNameValue, rgold.Row, rgold.Column Next End If Next If isFor = False Then val = Split(bsType(0), ";") For n = LBound(val) To UBound(val) callFunctionXQ val(n), sheetNameValue, rgold.Row, rgold.Column Next End If ElseIf UBound(rowType) <> 0 Then typeRow = rowType(0) If rgold.Row = typeRow Then val = Split(rowType(1), ";") For n = LBound(val) To UBound(val) callFunctionXQ val(n), sheetNameValue, rgold.Row, rgold.Column Next End If Else If rgold.Row = headIndex Then Else val = Split(bsType(0), ";") For n = LBound(val) To UBound(val) callFunctionXQ val(n), sheetNameValue, rgold.Row, rgold.Column Next End If End If Else End If End If Set rgold = Target End Sub Attribute VB_Name = "打印预览" Sub Browse_Print() Worksheets("学生信息打印模板").Visible = True Worksheets("学生信息打印模板").PrintPreview Worksheets("学生信息打印模板").Visible = True End Sub Attribute VB_Name = "工具函数" Function checkedRequiredStart(rowIndex, columnIndex) Dim cellValue As String cellValue = ActiveSheet.Cells(rowIndex, columnIndex) If cellValue = "" Then checkedRequiredStart = False Else checkedRequiredStart = True End If End Function Function writeLog(content As String) Sheets(msgSheetName).Cells(curMsgRow, 1) = content curMsgRow = curMsgRow + 1 End Function Function writeLogRed(content As String) nLen = Len(content) Sheets(msgSheetName).Cells(curMsgRow, 1) = content Sheets(msgSheetName).Cells(curMsgRow, 1).Characters(1, nLen).Font.ColorIndex = 3 curMsgRow = curMsgRow + 1 End Function Function addCommentXQ(rowIndex, columnIndex, errorInfo) ActiveSheet.Unprotect Password:=123 ActiveSheet.Cells(rowIndex, columnIndex).AddComment (errorInfo) ActiveSheet.Cells(rowIndex, columnIndex).Interior.Color = 65535 ActiveSheet.Cells(rowIndex, columnIndex).Comment.Visible = False ActiveSheet.Protect Password:=123 End Function Function clearCommentsXQ(rowIndex, columnIndex) ActiveSheet.Unprotect Password:=123 ActiveSheet.Cells(rowIndex, columnIndex).ClearComments ActiveSheet.Cells(rowIndex, columnIndex).Interior.ColorIndex = xlNone ActiveSheet.Protect Password:=123 End Function Function addCommentXQStart(sheetName, rowIndex, columnIndex, errorInfo) Sheets(sheetName).Unprotect Password:=123 Sheets(sheetName).Cells(rowIndex, columnIndex).AddComment (errorInfo) Sheets(sheetName).Cells(rowIndex, columnIndex).Interior.Color = 65535 Sheets(sheetName).Cells(rowIndex, columnIndex).Comment.Visible = False Sheets(sheetName).Protect Password:=123 End Function Function clearCommentsXQStart(sheetName, rowIndex, columnIndex) Sheets(sheetName).Unprotect Password:=123 Sheets(sheetName).Cells(rowIndex, columnIndex).ClearComments If rowIndex = sheet2RecordNum And columnIndex = ffTotalNumColumn Then Sheets(sheetName).Cells(rowIndex, columnIndex).Interior.ColorIndex = 15 Else Sheets(sheetName).Cells(rowIndex, columnIndex).Interior.ColorIndex = xlNone End If Sheets(sheetName).Protect Password:=123 End Function Function beginCheck_comment(sheetName, checkMethod, rowIndex, columnIndex, errorMsg) If Not checkMethod Then If Sheets(sheetName).Cells(rowIndex, columnIndex).Comment Is Nothing Then addCommentXQStart sheetName, rowIndex, columnIndex, errorMsg Else clearCommentsXQStart sheetName, rowIndex, columnIndex addCommentXQStart sheetName, rowIndex, columnIndex, errorMsg End If Else clearCommentsXQStart sheetName, rowIndex, columnIndex If removeSpaceFlag Then writeLog "第" & rowIndex & "行，第" & columnIndex & "列，您输入的字符" & Chr(34) & cellContent & Chr(34) & "中包含了空格，系统已自动为您清除了" Else End If End If End Function Function callFunctionXQStart(typeVal, sheetName, rowIndex, columnIndex, isValidateCount) value = Sheets(sheetName).Cells(rowIndex, columnIndex) titleMsg = Sheets(sheetName).Cells(startTitle, columnIndex) If titleMsg = "" Then titleMsg = Sheets(sheetName).Cells(startTitle - 1, columnIndex) ElseIf rowIndex = headIndex Then titleMsg = Sheets(sheetName).Cells(headIndex, columnIndex - 1) End If Select Case typeVal Case "checkNull" checkMethodXQ = checkRequired(sheetName, rowIndex, columnIndex) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "不能为空！请检查" hasError = True writeLog errorMsg End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkName" removeSpaceXQ sheetName, rowIndex, columnIndex value = Sheets(sheetName).Cells(rowIndex, columnIndex).value checkMethodXQ = checkStuName(value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！必须为汉字，长度大于1，不能超过20个字符，请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkBornDate" checkMethodXQ = checkRequired(sheetName, rowIndex, columnIndex + 1) If Not checkMethodXQ Then checkMethodXQ = checkBirthday(value) If Not checkMethodXQ Then hasErrorIdNum = True errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "xxxx/xx/xx" & Chr(34) & " ，如2013/2/21，请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If Else If value = "" Then checkMethodXQ = True Else checkMethodXQ = checkBirthday(value) If Not checkMethodXQ Then hasErrorIdNum = True errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "xxxx/xx/xx" & Chr(34) & " ，如2013/2/21，请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If End If End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkDate" ' checkMethodXQ = checkBirthday(value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "xxxx/xx/xx" & Chr(34) & " ，如2013/12/21，请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkIdNum" checkMethodXQ = IsIDNumber(value, columnIndex) If columnIndex = babyIDColumn Then If Not hasErrorIdNum Then If value <> "" Then If checkMethodXQ Then checkMethodXQ = checkIdNumLink(value, rowIndex, columnIndex) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：性别或出生日期填写不正确，与身份证中信息不一致！请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg Else errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确，请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg End If Else beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg End If Else errorMsg = "第" & rowIndex & "行的数据项：性别或出生日期填写不正确，请检查" hasError = True beginCheck_comment sheetName, False, rowIndex, columnIndex, errorMsg End If Else If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg End If isFor = True Case "checkPhone" checkMethodXQ = checkPhoneNum(value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "区号-固定电话或手机号码" & Chr(34) & " ，请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkSchoolYear" checkMethodXQ = checkSchoolYear(value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "xxxx-xxxx" & Chr(34) & ",如2011-2012，请检查" hasError = True writeLog errorMsg End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkRXDate" checkMethodXQ = checkRXDate(value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式如200809，请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkMoney" checkMethodXQ = checkMoney(value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！若金额数为0,请填写0，最大不超过9999，请检查" hasError = True writeLog errorMsg End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkOption" checkMethodXQ = checkOption(value, 200) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！长度不能超过200个字符，请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkRuralUrban" checkMethodXQ = checkSzdcxlx("checkRuralUrban", value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkGender" checkMethodXQ = checkRequired(sheetName, rowIndex, columnIndex + 2) '判断身份证号是否为空 If Not checkMethodXQ Then checkMethodXQ = checkGender("checkGender", value) If Not checkMethodXQ Then hasErrorIdNum = True errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If Else checkMethodXQ = True End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkYesNo" checkMethodXQ = checkSF("checkYesNo", value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkIdCardType" If Not checkSfzjlx("checkIdCardType", value) Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg End If beginCheck_comment sheetName, checkSfzjlx("checkIdCardType", value), rowIndex, columnIndex, errorMsg isFor = True Case "checkNation" checkMethodXQ = checkMZ("checkNation", value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkAccount" checkMethodXQ = checkHKXZ("checkAccount", value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkClassType" checkMethodXQ = checkBJLB("checkClassType", value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "不正确！请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkZZFS" checkMethodXQ = checkZZFS("checkZZFS", value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkStateLocal" If Not checkDMB("checkStateLocal", value) Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg End If beginCheck_comment sheetName, checkDMB("checkStateLocal", value), rowIndex, columnIndex, errorMsg isFor = True Case "checkPoorReason" checkMethodXQ = checkDMB("checkPoorReason", value) If Not checkMethodXQ Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg isValidateCount = isValidateCount + 1 End If beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg isFor = True Case "checkTerm" If Not checkTerm("checkTerm", value) Then errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查" hasError = True writeLog errorMsg End If beginCheck_comment sheetName, checkTerm("checkTerm", value), rowIndex, columnIndex, errorMsg isFor = True Case "checkAtLeastOneNNull" atLeaOneNNullCount = atLeaOneNNullCount + 1 If checkMoney(value) And value <> 0 Then totalMoney = totalMoney + value Select Case columnIndex Case baojiaoMoneyColumn: baojiaoMoneySum = baojiaoMoneySum + value Case huoshiMoneyColumn: huoshiMoneySum = huoshiMoneySum + value Case zhusuMoneyColumn: zhusuMoneySum = zhusuMoneySum + value Case othersMoneyColumn: othersMoneySum = othersMoneySum + value End Select Else atLeaOneNullCount = atLeaOneNullCount + 1 atLeaError = atLeaError + titleMsg + " " End If isFor = True End Select End Function Function regCheckFunc(reg, value) Dim regEX As Object Set regEX = CreateObject("VBSCRIPT.REGEXP") regEX.Global = True regEX.Pattern = reg regEX.IgnoreCase = False regCheckFunc = regEX.Test(value) Set regEX = Nothing End Function Function checkTheSameXQNew(sheetName2) rna = Sheets(sheetName2).Range("A65535").End(xlUp).Row cna = Sheets(sheetName2).Range("8:8").Find(What:="", After:=[a8], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column Sheets(msgSheetName).Cells.ClearContents curMsgRow = 1 For i = startTitle + 2 To rna babyID1 = Sheets(sheetName2).Cells(i, babyIDColumn) For j = startTitle + 2 To i - 1 babyID2 = Sheets(sheetName2).Cells(j, babyIDColumn) If babyID1 <> "" And babyID2 <> "" Then If babyID1 = babyID2 Then errorMsg = sheetNameValue1 & "表中，第" & j & "行的数据和第" & i & "行数据重复！请检查!!!!" writeLog errorMsg hasTheSame = True Else End If Else jhrIDCard1 = Sheets(sheetName2).Cells(i, jhrIDColumn) jhrIDCard2 = Sheets(sheetName2).Cells(j, jhrIDColumn) If jhrIDCard1 <> "" And jhrIDCard2 <> "" And jhrIDCard1 = jhrIDCard2 Then babyName1 = Sheets(sheetName2).Cells(i, babyNameColumn) babyName2 = Sheets(sheetName2).Cells(j, babyNameColumn) babyGender1 = Sheets(sheetName2).Cells(i, babyGenderColumn) babyGender2 = Sheets(sheetName2).Cells(j, babyGenderColumn) babyBirthday1 = Sheets(sheetName2).Cells(i, babyBirthdayColumn) babyBirthday2 = Sheets(sheetName2).Cells(j, babyBirthdayColumn) babyBirthday1 = Format(CDate(babyBirthday1), "yyyy/m/d") babyBirthday2 = Format(CDate(babyBirthday2), "yyyy/m/d") jhrName1 = Sheets(sheetName2).Cells(i, jhrNameColumn) jhrName2 = Sheets(sheetName2).Cells(j, jhrNameColumn) If babyName1 = babyName2 And babyGender1 = babyGender2 And babyBirthday1 = babyBirthday2 And jhrName1 = jhrName2 Then errorMsg = sheetNameValue1 & "表中，第" & j & "行的数据和第" & i & "行数据重复！请检查!!!!" writeLog errorMsg hasTheSame = True Else End If End If End If Next Next End Function Function GetRowOrColIndex(ByVal sheetName, ByVal keyWord, ByVal kbn As String) As Integer GetRowOrColIndex = -1 Dim c As Object Set c = Sheets(sheetName).Range("A1:A65535").Find(What:=keyWord, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then If kbn = "row" Then GetRowOrColIndex = c.Row Else GetRowOrColIndex = c.Column End If End If End Function Function checkDMB(value, value1) Dim rowData Count = 0 rowNum = Sheets(AreaSheetName).Range("A65535").End(xlUp).Row checkDMB = False rowData = GetRowOrColIndex(AreaSheetName, value, "row") For i = rowData To rowNum If Sheets(AreaSheetName).Cells(i, 1) = value Then Count = Count + 1 Else Exit For End If Next i For j = rowData To rowData + Count - 1 If Sheets(AreaSheetName).Cells(j, 3) = value1 Then checkDMB = True Exit For End If Next j End Function Function deleteRow(sheetName, rowNum) Sheets(sheetName).Unprotect Password:=123 Sheets(sheetName).Rows(rowNum).Delete Sheets(sheetName).Protect Password:=123 End Function Function deleteRowNoPro(sheetName, rowNum) Sheets(sheetName).Rows(rowNum).Delete End Function Function setCellValueXQ(sheetName, rowIndex, colIndex, value) Sheets(sheetName).Unprotect Password:=123 Sheets(sheetName).Cells(rowIndex, colIndex).value = value Sheets(sheetName).Protect Password:=123 End Function Function removeSpaceXQ(sheetName, rowIndex, colIndex) Dim value1 As String Dim length1 As Integer, length2 As Integer removeSpaceXQ = False Sheets(sheetName).Unprotect Password:=123 value1 = Sheets(sheetName).Cells(rowIndex, colIndex).value length1 = Len(value1) If length1 = 0 Then Exit Function length2 = InStr(value1, " ") If length2 <> 0 Then value1 = Replace(value1, " ", "") Sheets(sheetName).Cells(rowIndex, colIndex).value = value1 removeSpaceXQ = True End If Sheets(sheetName).Protect Password:=123 End Function Attribute VB_Name = "开始使用" Sub Begin_Click() Sheets(sheetNameValue).Visible = True Sheets(sheetNameValue).Select End Sub Attribute VB_Name = "声明" Public Type ValueColumType columnIndex As Integer columnName As String End Type Public Const sheetNameValue1 As String = "附件1资助幼儿明细" Public Const sheetNameValueTJ As String = "附件2政策落实统计" Public Const msgSheetName As String = "错误信息" Public Const IntroSheetName As String = "填表说明" Public Const AreaSheetName As String = "代码表" Public Const readmeSheetName As String = "说明" Public totalCount As Integer Public Const startTitle = 8 Public atLeaOneNNullCount Public atLeaOneNullCount Public totalMoney As Variant Public atLeaError Public errorMsg As String Public rgold As Range Public Target As Range Public isSaveButton As Integer Public hasError As Boolean Public hasTheSame As Boolean Public hasErrorIdNum As Boolean Public hasErrorInValidate As Boolean Public checkMethodXQ As Boolean Public Const dataRowStart As Integer = 2 Public Const babyNameColumn As Integer = 1 Public Const babyGenderColumn As Integer = 2 Public Const babyBirthdayColumn As Integer = 3 Public Const babyIDColumn As Integer = 4 Public Const jhrNameColumn As Integer = 10 Public Const jhrIDColumn As Integer = 11 Public Const baojiaoMoneyColumn = 13 Public Const huoshiMoneyColumn = 14 Public Const zhusuMoneyColumn = 15 Public Const othersMoneyColumn = 16 Public totalMoneySum As Variant Public baojiaoMoneySum As Variant Public huoshiMoneySum As Variant Public zhusuMoneySum As Variant Public othersMoneySum As Variant Public ydTotalNum As Variant Public sdTotalNum As Variant Public avgMoney As Variant Dim isNullRowNum As Integer Dim isValidateCount As Integer Public removeSpaceFlag As Boolean Public cellContent Public curMsgRow As Long Public rna As Integer Public cna As Integer Public isFor As Boolean Public Const headIndex = 3 Public notContinueBool As Boolean Public Const sheet2RecordNum = 9 Public Const shifouColumn = 8 Public Const lishugxColumn = 6 Public Const inSchStuNumColumn = 9 Public Const familyPoorNumColumn = 10 Public Const ydTotalMoneyColumn = 11 Public Const sdTotalMoneyColumn = 12 Public Const djDateColumn = 13 Public Const ffTotalNumColumn = 14 Public Const totalMoneyColumnTJ = 15 Public Const baojiaoMoneyColumnTJ = 16 Public Const huoshiMoneyColumnTJ = 17 Public Const zhusuMoneyColumnTJ = 18 Public Const othersMoneyColumnTJ = 19 Public Const avgMoneyColumnTJ = 20 Public Const ffDateColumnTJ = 21 Public Const ffWayColumnTJ = 22 Public Const optionColumnTJ = 23 Public hasErrorTJ As Boolean Public hasErrorTJZYRS As Boolean Public hasErrorKNRS As Boolean Public Const errorMsgTJJJKN = "家庭经济困难人数填写不正确，大于0，并且不能超过在园人数，请检查" Public Const errorMsgTJFFNum = "发放总人数应小于在园人数，请检查在园人数填写是否正确，请检查" Attribute VB_Name = "校验函数" Function checkRequired(sheetName, rowIndex, columnIndex) Dim cellValue As String cellValue = Sheets(sheetName).Cells(rowIndex, columnIndex) If cellValue = "" Then checkRequired = False Else checkRequired = True End If End Function Function checkStuName(value) Dim reg reg = "^[\u4e00-\u9fbf]{2,20}$" If regCheckFunc(reg, value) Then checkStuName = True Else checkStuName = False End If End Function Function checkBirthday(value) Dim reg reg = "^((19)\|(20))\d{2}/((((0?[13578])\|(1[02]))/((0?[1-9])\|([12][0-9])\|(3[01])))\|(((0?[469])\|(11))/((0?[1-9])\|([12][0-9])\|(30)))\|((0?2)/((0?[1-9])\|([12][0-9]))))$" If regCheckFunc(reg, value) Then checkBirthday = True Else checkBirthday = False End If End Function Function IsIDNumber(ByVal IDNumber As String, ByVal colIndex As String) As Boolean Const W As String = "79058421637905842" Const c As String = "10X98765432" IDNumber = UCase(Trim(IDNumber)) Dim s As Integer, i As Integer, T As Integer If colIndex = babyIDColumn And IDNumber = "" Then IsIDNumber = True Exit Function End If If Len(IDNumber) <> 18 Then Exit Function If Not IsNumeric(Mid(IDNumber, 1, 17)) Then Exit Function If Not IDNumber Like "[0-9X]" Then Exit Function For i = 1 To 17 T = Mid(W, i, 1) If T = 0 Then T = 10 s = s + Mid(IDNumber, i, 1) * T Next T = s Mod 11 If Right(IDNumber, 1) = Mid(c, T + 1, 1) Then IsIDNumber = True End Function Function checkSchCode(value) Dim reg reg = "^[1-9]\d{40}[\dx]$" If regCheckFunc(reg, value) Then checkSchCode = True Else checkSchCode = False End If End Function Function checkFamType(value) Dim reg reg = "^(\u519c\u6751)\|(\u53bf\u9547)\|(\u57ce\u5e02)$" If regCheckFunc(reg, value) Then checkFamType = True Else checkFamType = False End If End Function Function checkRXDate(value) Dim reg reg = "^(((19)\|(20))\d{2})((0[0-9])\|(1[0-2]))$" If regCheckFunc(reg, value) Then checkRXDate = True Else checkRXDate = False End If End Function Function checkGrade(value) Dim reg reg = "^[123]$" If regCheckFunc(reg, value) Then checkGrade = True Else checkGrade = False End If End Function Function checkXJH(value) Dim reg reg = "^\d{4}[0-7]\d{3}[0-3]\d{7}$" If regCheckFunc(reg, value) Then checkXJH = True Else checkXJH = False End If End Function Function checkPhoneNum(value) Dim reg reg = "\b((1(([38]\d)\|(4[57])\|(5[0-35-9]))\d{8})\|(0((10)\|(2[\d]))-[2-9]\d)\|(0[3-9]\d{2}-[2-9]\d))\b" If regCheckFunc(reg, value) Then checkPhoneNum = True Else checkPhoneNum = False End If End Function Function checkBank(value) Dim reg reg = "^[1-9]\d{15,18}$" If regCheckFunc(reg, value) Then checkBank = True Else checkBank = False End If End Function Function checkSchoolYear(value) Dim reg Dim years reg = "^20\d{2}-20\d{2}$" If regCheckFunc(reg, value) Then years = Split(value, "-") If years(1) - years(0) = 1 Then checkSchoolYear = True Else checkSchoolYear = False End If Else checkSchoolYear = False End If End Function Function checkOption(value1, value2) If value1 = "" Then checkOption = True Exit Function End If If Len(value1) > value2 Then checkOption = False Else checkOption = True End If End Function Function compare(value1, value2) value1 = CInt(value1) value2 = CInt(value2) If value1 > value2 Then compare = False Else compare = True End If End Function Function compareDec(value1, value2) value1 = CDec(value1) value2 = CDec(value2) If value1 > value2 Then compareDec = False Else compareDec = True End If End Function Function checkSzdcxlx(value, value1) checkSzdcxlx = checkDMB(value, value1) End Function Function checkSF(value, value1) checkSF = checkDMB(value, value1) End Function Function checkGender(value, value1) checkGender = checkDMB(value, value1) End Function Function checkSfzjlx(value, value1) checkSfzjlx = checkDMB(value, value1) End Function Function checkMZ(value, value1) checkMZ = checkDMB(value, value1) End Function Function checkHKXZ(value, value1) checkHKXZ = checkDMB(value, value1) End Function Function checkBJLB(value, value1) checkBJLB = checkDMB(value, value1) End Function Function checkZZFS(value, value1) checkZZFS = checkDMB(value, value1) End Function Function checkTerm(value, value1) checkTerm = checkDMB(value, value1) End Function Function checkMoney(value) Dim reg reg = "^(([1-9](\d{0,3})\|0)\|0)$" If regCheckFunc(reg, value) Then checkMoney = True Else checkMoney = False End If End Function Function checkMoneyTJ(value) Dim reg reg = "^[1-9]\d{0,7}$" If regCheckFunc(reg, value) Then checkMoneyTJ = True Else checkMoneyTJ = False End If End Function Function checkPersonNum(value) Dim reg reg = "^(([1-9]\d{0,3}))$" If regCheckFunc(reg, value) Then checkPersonNum = True Else checkPersonNum = False End If End Function Function checkIdNumLink(IdNum, rowIndex, colIndex) Dim isGenderRight As Boolean Dim isBirthRight As Boolean Dim length2 As Integer Dim genderValue As String Dim genderValue1 As Integer Dim birthValue As String Dim birthValue1 As String Dim year, year1 As Variant Dim month, month1 As Variant Dim day, day1 As Variant Dim arr genderValue = Sheets(sheetNameValue1).Cells(rowIndex, babyGenderColumn) genderValue = Trim(genderValue) genderValue1 = Mid(IdNum, 17, 1) birthValue = Sheets(sheetNameValue1).Cells(rowIndex, babyBirthdayColumn) birthValue1 = Mid(IdNum, 7, 8) If genderValue = "" Then If genderValue1 Mod 2 = 1 Then Sheets(sheetNameValue1).Cells(rowIndex, babyGenderColumn) = "男" isGenderRight = True Else Sheets(sheetNameValue1).Cells(rowIndex, babyGenderColumn) = "女" isGenderRight = True End If Else If genderValue = "男" And genderValue1 Mod 2 = 1 Then isGenderRight = True ElseIf genderValue = "女" And genderValue1 Mod 2 = 0 Then isGenderRight = True Else isGenderRight = False End If End If birthValue = Trim(birthValue) If birthValue = "" Then year = Mid(birthValue1, 1, 4) month = Mid(birthValue1, 5, 2) day = Mid(birthValue1, 7, 2) Sheets(sheetNameValue1).Cells(rowIndex, babyBirthdayColumn) = year + "/" + month + "/" + day isBirthRight = True Else arr = Split(birthValue, "/") If UBound(arr) > 0 Then Else isBirthRight = False Exit Function End If year = arr(0) month = arr(1) day = arr(2) If CDec(month) < 10 Then birthValue = year & "0" & CDec(month) Else birthValue = year & "" & month End If If CDec(day) < 10 Then birthValue = birthValue & "0" & CDec(day) Else birthValue = birthValue & "" & day End If If birthValue = birthValue1 Then isBirthRight = True Else isBirthRight = False End If End If If isGenderRight And isBirthRight Then checkIdNumLink = True Else checkIdNumLink = False End If End Function Attribute VB_Name = "主程序" Sub 测试统计表中规则() End Sub Sub 测试所有校验规则并打印错误信息() Dim titleMsg$, errorMsgZZBZ$, rowDataNum% Dim typeValue Dim bsType Dim valEntity Dim val Dim typeRow Dim isNullRowArr(500) As Integer Sheets(msgSheetName).Cells.ClearContents curMsgRow = 1 hasError = False hasErrorTJ = False Application.ScreenUpdating = False Sheets(msgSheetName).Cells.ClearContents rna = Sheets(sheetNameValue1).Range("A65530").End(xlUp).Row cna = Sheets(sheetNameValue1).Range("8:8").Find(What:="*", After:=[a8], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column setCellValueXQ AreaSheetName, 41, 8, "0" totalMoneySum = 0 baojiaoMoneySum = 0 huoshiMoneySum = 0 zhusuMoneySum = 0 othersMoneySum = 0 avgMoney = 0 isNullRowNum = 0 If isSaveButton = vbOK Then Else If MsgBox("您确定开始检查吗？检查过程中，请勿关闭excel，" & Chr(10) & "否则可能导致数据丢失或检查失败", vbOKCancel, "温馨提示") = vbOK Then Else Exit Sub End If End If Cells.Hyperlinks.Delete Sheets(sheetNameValue1).Tab.ColorIndex = -4142 setCellValueXQ sheetNameValueTJ, sheet2RecordNum, ffTotalNumColumn, 0 setCellValueXQ sheetNameValueTJ, sheet2RecordNum, totalMoneyColumnTJ, totalMoneySum setCellValueXQ sheetNameValueTJ, sheet2RecordNum, baojiaoMoneyColumnTJ, baojiaoMoneySum setCellValueXQ sheetNameValueTJ, sheet2RecordNum, huoshiMoneyColumnTJ, huoshiMoneySum setCellValueXQ sheetNameValueTJ, sheet2RecordNum, zhusuMoneyColumnTJ, zhusuMoneySum setCellValueXQ sheetNameValueTJ, sheet2RecordNum, othersMoneyColumnTJ, othersMoneySum setCellValueXQ sheetNameValueTJ, sheet2RecordNum, avgMoneyColumnTJ, avgMoney Set headIndexCol = Sheets(sheetNameValue1).Range("IV3").End(xlToLeft) For columnIndex = 2 To headIndexCol.Column + 1 If columnIndex Mod 2 = 1 Then typeValue = Sheets(sheetNameValue1).Cells(1, columnIndex).value isFor = False …

SHA-256: d92c15a309249515e6a7dbae1d6729eb25116d4faaa5a27fea5d56318448b155

Preview script

First 1,000 lines of the extracted script

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Workbook_BeforeClose(Cancel As Boolean)
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
isSaveButton = MsgBox("您是否确认将要保存该excel，如保存，请点击" & Chr(34) & "确定" & Chr(34) & "," & Chr(10) & "系统将要进行检查校验，如不保存，请点击" & Chr(34) & "取消" & Chr(34) & "?", vbOKCancel)
If isSaveButton = vbOK Then
测试所有校验规则并打印错误信息
Else
Cancel = True
End If
End Sub
Private Sub Workbook_Open()
Application.CommandBars("ply").Enabled = True
End Sub

Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet4"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "sheet中过程"
Sub Cell_SelectionChange(ByVal Target As Range)
Dim titleMsg$, typeValue
Dim bsType
Dim valEntity
Dim val
Dim typeRow
isFor = False
If rgold Is Nothing Then
Else
rna = ActiveSheet.Range("A65535").End(xlUp).Row
cna = ActiveSheet.Range("IV" & startTitle).End(xlToLeft).Column
typeValue = ActiveSheet.Cells(1, rgold.Column).value
If rgold.Row > rna Or rgold.Column > cna Or (rgold.Row < startTitle + 2 And rgold.Row <> headIndex) Then
ElseIf typeValue <> "" Then
bsType = Split(typeValue, "-")
rowType = Split(typeValue, ":")
If UBound(bsType) <> 0 Then
For m = LBound(bsType) + 1 To UBound(bsType)
valEntity = Split(bsType(m), ":")
typeRow = valEntity(0)
If rgold.Row = typeRow Then
val = Split(valEntity(1), ";")
For n = LBound(val) To UBound(val)
callFunctionXQ val(n), sheetNameValue, rgold.Row, rgold.Column
Next
End If
Next
If isFor = False Then
val = Split(bsType(0), ";")
For n = LBound(val) To UBound(val)
callFunctionXQ val(n), sheetNameValue, rgold.Row, rgold.Column
Next
End If
ElseIf UBound(rowType) <> 0 Then
typeRow = rowType(0)
If rgold.Row = typeRow Then
val = Split(rowType(1), ";")
For n = LBound(val) To UBound(val)
callFunctionXQ val(n), sheetNameValue, rgold.Row, rgold.Column
Next
End If
Else
If rgold.Row = headIndex Then
Else
val = Split(bsType(0), ";")
For n = LBound(val) To UBound(val)
callFunctionXQ val(n), sheetNameValue, rgold.Row, rgold.Column
Next
End If
End If
Else
End If
End If
Set rgold = Target
End Sub

Attribute VB_Name = "打印预览"
Sub Browse_Print()
Worksheets("学生信息打印模板").Visible = True
Worksheets("学生信息打印模板").PrintPreview
Worksheets("学生信息打印模板").Visible = True
End Sub

Attribute VB_Name = "工具函数"
Function checkedRequiredStart(rowIndex, columnIndex)
Dim cellValue As String
cellValue = ActiveSheet.Cells(rowIndex, columnIndex)
If cellValue = "" Then
checkedRequiredStart = False
Else
checkedRequiredStart = True
End If
End Function
Function writeLog(content As String)
Sheets(msgSheetName).Cells(curMsgRow, 1) = content
curMsgRow = curMsgRow + 1
End Function
Function writeLogRed(content As String)
nLen = Len(content)
Sheets(msgSheetName).Cells(curMsgRow, 1) = content
Sheets(msgSheetName).Cells(curMsgRow, 1).Characters(1, nLen).Font.ColorIndex = 3
curMsgRow = curMsgRow + 1
End Function
Function addCommentXQ(rowIndex, columnIndex, errorInfo)
ActiveSheet.Unprotect Password:=123
ActiveSheet.Cells(rowIndex, columnIndex).AddComment (errorInfo)
ActiveSheet.Cells(rowIndex, columnIndex).Interior.Color = 65535
ActiveSheet.Cells(rowIndex, columnIndex).Comment.Visible = False
ActiveSheet.Protect Password:=123
End Function
Function clearCommentsXQ(rowIndex, columnIndex)
ActiveSheet.Unprotect Password:=123
ActiveSheet.Cells(rowIndex, columnIndex).ClearComments
ActiveSheet.Cells(rowIndex, columnIndex).Interior.ColorIndex = xlNone
ActiveSheet.Protect Password:=123
End Function
Function addCommentXQStart(sheetName, rowIndex, columnIndex, errorInfo)
Sheets(sheetName).Unprotect Password:=123
Sheets(sheetName).Cells(rowIndex, columnIndex).AddComment (errorInfo)
Sheets(sheetName).Cells(rowIndex, columnIndex).Interior.Color = 65535
Sheets(sheetName).Cells(rowIndex, columnIndex).Comment.Visible = False
Sheets(sheetName).Protect Password:=123
End Function
Function clearCommentsXQStart(sheetName, rowIndex, columnIndex)
Sheets(sheetName).Unprotect Password:=123
Sheets(sheetName).Cells(rowIndex, columnIndex).ClearComments
If rowIndex = sheet2RecordNum And columnIndex = ffTotalNumColumn Then
Sheets(sheetName).Cells(rowIndex, columnIndex).Interior.ColorIndex = 15
Else
Sheets(sheetName).Cells(rowIndex, columnIndex).Interior.ColorIndex = xlNone
End If
Sheets(sheetName).Protect Password:=123
End Function
Function beginCheck_comment(sheetName, checkMethod, rowIndex, columnIndex, errorMsg)
If Not checkMethod Then
If Sheets(sheetName).Cells(rowIndex, columnIndex).Comment Is Nothing Then
addCommentXQStart sheetName, rowIndex, columnIndex, errorMsg
Else
clearCommentsXQStart sheetName, rowIndex, columnIndex
addCommentXQStart sheetName, rowIndex, columnIndex, errorMsg
End If
Else
clearCommentsXQStart sheetName, rowIndex, columnIndex
If removeSpaceFlag Then
writeLog "第" & rowIndex & "行，第" & columnIndex & "列，您输入的字符" & Chr(34) & cellContent & Chr(34) & "中包含了空格，系统已自动为您清除了"
Else
End If
End If
End Function
Function callFunctionXQStart(typeVal, sheetName, rowIndex, columnIndex, isValidateCount)
value = Sheets(sheetName).Cells(rowIndex, columnIndex)
titleMsg = Sheets(sheetName).Cells(startTitle, columnIndex)
If titleMsg = "" Then
titleMsg = Sheets(sheetName).Cells(startTitle - 1, columnIndex)
ElseIf rowIndex = headIndex Then
titleMsg = Sheets(sheetName).Cells(headIndex, columnIndex - 1)
End If
Select Case typeVal
Case "checkNull"
checkMethodXQ = checkRequired(sheetName, rowIndex, columnIndex)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "不能为空！请检查"
hasError = True
writeLog errorMsg
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkName"
removeSpaceXQ sheetName, rowIndex, columnIndex
value = Sheets(sheetName).Cells(rowIndex, columnIndex).value
checkMethodXQ = checkStuName(value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！必须为汉字，长度大于1，不能超过20个字符，请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkBornDate"
checkMethodXQ = checkRequired(sheetName, rowIndex, columnIndex + 1)
If Not checkMethodXQ Then
checkMethodXQ = checkBirthday(value)
If Not checkMethodXQ Then
hasErrorIdNum = True
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "xxxx/xx/xx" & Chr(34) & " ，如2013/2/21，请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
Else
If value = "" Then
checkMethodXQ = True
Else
checkMethodXQ = checkBirthday(value)
If Not checkMethodXQ Then
hasErrorIdNum = True
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "xxxx/xx/xx" & Chr(34) & " ，如2013/2/21，请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
End If
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkDate" '
checkMethodXQ = checkBirthday(value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "xxxx/xx/xx" & Chr(34) & " ，如2013/12/21，请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkIdNum"
checkMethodXQ = IsIDNumber(value, columnIndex)
If columnIndex = babyIDColumn Then
If Not hasErrorIdNum Then
If value <> "" Then
If checkMethodXQ Then
checkMethodXQ = checkIdNumLink(value, rowIndex, columnIndex)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：性别或出生日期填写不正确，与身份证中信息不一致！请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
Else
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确，请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
End If
Else
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
End If
Else
errorMsg = "第" & rowIndex & "行的数据项：性别或出生日期填写不正确，请检查"
hasError = True
beginCheck_comment sheetName, False, rowIndex, columnIndex, errorMsg
End If
Else
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
End If
isFor = True
Case "checkPhone"
checkMethodXQ = checkPhoneNum(value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "区号-固定电话 或 手机号码" & Chr(34) & " ，请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkSchoolYear"
checkMethodXQ = checkSchoolYear(value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式为" & Chr(34) & "xxxx-xxxx" & Chr(34) & ",如2011-2012，请检查"
hasError = True
writeLog errorMsg
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkRXDate"
checkMethodXQ = checkRXDate(value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！填写格式如200809，请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkMoney"
checkMethodXQ = checkMoney(value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！若金额数为0,请填写0，最大不超过9999，请检查"
hasError = True
writeLog errorMsg
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkOption"
checkMethodXQ = checkOption(value, 200)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！长度不能超过200个字符，请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkRuralUrban"
checkMethodXQ = checkSzdcxlx("checkRuralUrban", value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkGender"
checkMethodXQ = checkRequired(sheetName, rowIndex, columnIndex + 2) '判断身份证号是否为空
If Not checkMethodXQ Then
checkMethodXQ = checkGender("checkGender", value)
If Not checkMethodXQ Then
hasErrorIdNum = True
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
Else
checkMethodXQ = True
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkYesNo"
checkMethodXQ = checkSF("checkYesNo", value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkIdCardType"
If Not checkSfzjlx("checkIdCardType", value) Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
End If
beginCheck_comment sheetName, checkSfzjlx("checkIdCardType", value), rowIndex, columnIndex, errorMsg
isFor = True
Case "checkNation"
checkMethodXQ = checkMZ("checkNation", value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkAccount"
checkMethodXQ = checkHKXZ("checkAccount", value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkClassType"
checkMethodXQ = checkBJLB("checkClassType", value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "不正确！请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkZZFS"
checkMethodXQ = checkZZFS("checkZZFS", value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkStateLocal"
If Not checkDMB("checkStateLocal", value) Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
End If
beginCheck_comment sheetName, checkDMB("checkStateLocal", value), rowIndex, columnIndex, errorMsg
isFor = True
Case "checkPoorReason"
checkMethodXQ = checkDMB("checkPoorReason", value)
If Not checkMethodXQ Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
isValidateCount = isValidateCount + 1
End If
beginCheck_comment sheetName, checkMethodXQ, rowIndex, columnIndex, errorMsg
isFor = True
Case "checkTerm"
If Not checkTerm("checkTerm", value) Then
errorMsg = "第" & rowIndex & "行的数据项：" & titleMsg & "填写不正确！请检查"
hasError = True
writeLog errorMsg
End If
beginCheck_comment sheetName, checkTerm("checkTerm", value), rowIndex, columnIndex, errorMsg
isFor = True
Case "checkAtLeastOneNNull"
atLeaOneNNullCount = atLeaOneNNullCount + 1
If checkMoney(value) And value <> 0 Then
totalMoney = totalMoney + value
Select Case columnIndex
Case baojiaoMoneyColumn:
baojiaoMoneySum = baojiaoMoneySum + value
Case huoshiMoneyColumn:
huoshiMoneySum = huoshiMoneySum + value
Case zhusuMoneyColumn:
zhusuMoneySum = zhusuMoneySum + value
Case othersMoneyColumn:
othersMoneySum = othersMoneySum + value
End Select
Else
atLeaOneNullCount = atLeaOneNullCount + 1
atLeaError = atLeaError + titleMsg + " "
End If
isFor = True
End Select
End Function
Function regCheckFunc(reg, value)
Dim regEX As Object
Set regEX = CreateObject("VBSCRIPT.REGEXP")
regEX.Global = True
regEX.Pattern = reg
regEX.IgnoreCase = False
regCheckFunc = regEX.Test(value)
Set regEX = Nothing
End Function
Function checkTheSameXQNew(sheetName2)
rna = Sheets(sheetName2).Range("A65535").End(xlUp).Row
cna = Sheets(sheetName2).Range("8:8").Find(What:="*", After:=[a8], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
Sheets(msgSheetName).Cells.ClearContents
curMsgRow = 1
For i = startTitle + 2 To rna
babyID1 = Sheets(sheetName2).Cells(i, babyIDColumn)
For j = startTitle + 2 To i - 1
babyID2 = Sheets(sheetName2).Cells(j, babyIDColumn)
If babyID1 <> "" And babyID2 <> "" Then
If babyID1 = babyID2 Then
errorMsg = sheetNameValue1 & "表中，第" & j & "行的数据和第" & i & "行数据重复！请检查!!!!"
writeLog errorMsg
hasTheSame = True
Else
End If
Else
jhrIDCard1 = Sheets(sheetName2).Cells(i, jhrIDColumn)
jhrIDCard2 = Sheets(sheetName2).Cells(j, jhrIDColumn)
If jhrIDCard1 <> "" And jhrIDCard2 <> "" And jhrIDCard1 = jhrIDCard2 Then
babyName1 = Sheets(sheetName2).Cells(i, babyNameColumn)
babyName2 = Sheets(sheetName2).Cells(j, babyNameColumn)
babyGender1 = Sheets(sheetName2).Cells(i, babyGenderColumn)
babyGender2 = Sheets(sheetName2).Cells(j, babyGenderColumn)
babyBirthday1 = Sheets(sheetName2).Cells(i, babyBirthdayColumn)
babyBirthday2 = Sheets(sheetName2).Cells(j, babyBirthdayColumn)
babyBirthday1 = Format(CDate(babyBirthday1), "yyyy/m/d")
babyBirthday2 = Format(CDate(babyBirthday2), "yyyy/m/d")
jhrName1 = Sheets(sheetName2).Cells(i, jhrNameColumn)
jhrName2 = Sheets(sheetName2).Cells(j, jhrNameColumn)
If babyName1 = babyName2 And babyGender1 = babyGender2 And babyBirthday1 = babyBirthday2 And jhrName1 = jhrName2 Then
errorMsg = sheetNameValue1 & "表中，第" & j & "行的数据和第" & i & "行数据重复！请检查!!!!"
writeLog errorMsg
hasTheSame = True
Else
End If
End If
End If
Next
Next
End Function
Function GetRowOrColIndex(ByVal sheetName, ByVal keyWord, ByVal kbn As String) As Integer
GetRowOrColIndex = -1
Dim c As Object
Set c = Sheets(sheetName).Range("A1:A65535").Find(What:=keyWord, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
If kbn = "row" Then
GetRowOrColIndex = c.Row
Else
GetRowOrColIndex = c.Column
End If
End If
End Function
Function checkDMB(value, value1)
Dim rowData
Count = 0
rowNum = Sheets(AreaSheetName).Range("A65535").End(xlUp).Row
checkDMB = False
rowData = GetRowOrColIndex(AreaSheetName, value, "row")
For i = rowData To rowNum
If Sheets(AreaSheetName).Cells(i, 1) = value Then
Count = Count + 1
Else
Exit For
End If
Next i
For j = rowData To rowData + Count - 1
If Sheets(AreaSheetName).Cells(j, 3) = value1 Then
checkDMB = True
Exit For
End If
Next j
End Function
Function deleteRow(sheetName, rowNum)
Sheets(sheetName).Unprotect Password:=123
Sheets(sheetName).Rows(rowNum).Delete
Sheets(sheetName).Protect Password:=123
End Function
Function deleteRowNoPro(sheetName, rowNum)
Sheets(sheetName).Rows(rowNum).Delete
End Function
Function setCellValueXQ(sheetName, rowIndex, colIndex, value)
Sheets(sheetName).Unprotect Password:=123
Sheets(sheetName).Cells(rowIndex, colIndex).value = value
Sheets(sheetName).Protect Password:=123
End Function
Function removeSpaceXQ(sheetName, rowIndex, colIndex)
Dim value1 As String
Dim length1 As Integer, length2 As Integer
removeSpaceXQ = False
Sheets(sheetName).Unprotect Password:=123
value1 = Sheets(sheetName).Cells(rowIndex, colIndex).value
length1 = Len(value1)
If length1 = 0 Then Exit Function
length2 = InStr(value1, " ")
If length2 <> 0 Then
value1 = Replace(value1, " ", "")
Sheets(sheetName).Cells(rowIndex, colIndex).value = value1
removeSpaceXQ = True
End If
Sheets(sheetName).Protect Password:=123
End Function

Attribute VB_Name = "开始使用"
Sub Begin_Click()
Sheets(sheetNameValue).Visible = True
Sheets(sheetNameValue).Select
End Sub

Attribute VB_Name = "声明"
Public Type ValueColumType
columnIndex As Integer
columnName As String
End Type
Public Const sheetNameValue1  As String = "附件1资助幼儿明细"
Public Const sheetNameValueTJ As String = "附件2政策落实统计"
Public Const msgSheetName As String = "错误信息"
Public Const IntroSheetName As String = "填表说明"
Public Const AreaSheetName As String = "代码表"
Public Const readmeSheetName As String = "说明"
Public totalCount As Integer
Public Const startTitle = 8
Public atLeaOneNNullCount
Public atLeaOneNullCount
Public totalMoney As Variant
Public atLeaError
Public errorMsg As String
Public rgold As Range
Public Target As Range
Public isSaveButton As Integer
Public hasError As Boolean
Public hasTheSame As Boolean
Public hasErrorIdNum As Boolean
Public hasErrorInValidate As Boolean
Public checkMethodXQ As Boolean
Public Const dataRowStart As Integer = 2
Public Const babyNameColumn As Integer = 1
Public Const babyGenderColumn As Integer = 2
Public Const babyBirthdayColumn As Integer = 3
Public Const babyIDColumn As Integer = 4
Public Const jhrNameColumn As Integer = 10
Public Const jhrIDColumn As Integer = 11
Public Const baojiaoMoneyColumn = 13
Public Const huoshiMoneyColumn = 14
Public Const zhusuMoneyColumn = 15
Public Const othersMoneyColumn = 16
Public totalMoneySum As Variant
Public baojiaoMoneySum As Variant
Public huoshiMoneySum As Variant
Public zhusuMoneySum  As Variant
Public othersMoneySum As Variant
Public ydTotalNum As Variant
Public sdTotalNum As Variant
Public avgMoney As Variant
Dim isNullRowNum  As Integer
Dim isValidateCount As Integer
Public removeSpaceFlag As Boolean
Public cellContent
Public curMsgRow As Long
Public rna As Integer
Public cna As Integer
Public isFor As Boolean
Public Const headIndex = 3
Public notContinueBool As Boolean
Public Const sheet2RecordNum = 9
Public Const shifouColumn = 8
Public Const lishugxColumn = 6
Public Const inSchStuNumColumn = 9
Public Const familyPoorNumColumn = 10
Public Const ydTotalMoneyColumn = 11
Public Const sdTotalMoneyColumn = 12
Public Const djDateColumn = 13
Public Const ffTotalNumColumn = 14
Public Const totalMoneyColumnTJ = 15
Public Const baojiaoMoneyColumnTJ = 16
Public Const huoshiMoneyColumnTJ = 17
Public Const zhusuMoneyColumnTJ = 18
Public Const othersMoneyColumnTJ = 19
Public Const avgMoneyColumnTJ = 20
Public Const ffDateColumnTJ = 21
Public Const ffWayColumnTJ = 22
Public Const optionColumnTJ = 23
Public hasErrorTJ As Boolean
Public hasErrorTJZYRS As Boolean
Public hasErrorKNRS As Boolean
Public Const errorMsgTJJJKN = "家庭经济困难人数填写不正确，大于0，并且不能超过在园人数，请检查"
Public Const errorMsgTJFFNum = "发放总人数应小于在园人数，请检查在园人数填写是否正确，请检查"

Attribute VB_Name = "校验函数"
Function checkRequired(sheetName, rowIndex, columnIndex)
Dim cellValue As String
cellValue = Sheets(sheetName).Cells(rowIndex, columnIndex)
If cellValue = "" Then
checkRequired = False
Else
checkRequired = True
End If
End Function
Function checkStuName(value)
Dim reg
reg = "^[\u4e00-\u9fbf]{2,20}$"
If regCheckFunc(reg, value) Then
checkStuName = True
Else
checkStuName = False
End If
End Function
Function checkBirthday(value)
Dim reg
reg = "^((19)|(20))\d{2}/((((0?[13578])|(1[02]))/((0?[1-9])|([12][0-9])|(3[01])))|(((0?[469])|(11))/((0?[1-9])|([12][0-9])|(30)))|((0?2)/((0?[1-9])|([12][0-9]))))$"
If regCheckFunc(reg, value) Then
checkBirthday = True
Else
checkBirthday = False
End If
End Function
Function IsIDNumber(ByVal IDNumber As String, ByVal colIndex As String) As Boolean
Const W As String = "79058421637905842"
Const c As String = "10X98765432"
IDNumber = UCase(Trim(IDNumber))
Dim s As Integer, i As Integer, T As Integer
If colIndex = babyIDColumn And IDNumber = "" Then
IsIDNumber = True
Exit Function
End If
If Len(IDNumber) <> 18 Then Exit Function
If Not IsNumeric(Mid(IDNumber, 1, 17)) Then Exit Function
If Not IDNumber Like "*[0-9X]" Then Exit Function
For i = 1 To 17
T = Mid(W, i, 1)
If T = 0 Then T = 10
s = s + Mid(IDNumber, i, 1) * T
Next
T = s Mod 11
If Right(IDNumber, 1) = Mid(c, T + 1, 1) Then IsIDNumber = True
End Function
Function checkSchCode(value)
Dim reg
reg = "^[1-9]\d{40}[\dx]$"
If regCheckFunc(reg, value) Then
checkSchCode = True
Else
checkSchCode = False
End If
End Function
Function checkFamType(value)
Dim reg
reg = "^(\u519c\u6751)|(\u53bf\u9547)|(\u57ce\u5e02)$"
If regCheckFunc(reg, value) Then
checkFamType = True
Else
checkFamType = False
End If
End Function
Function checkRXDate(value)
Dim reg
reg = "^(((19)|(20))\d{2})((0[0-9])|(1[0-2]))$"
If regCheckFunc(reg, value) Then
checkRXDate = True
Else
checkRXDate = False
End If
End Function
Function checkGrade(value)
Dim reg
reg = "^[123]$"
If regCheckFunc(reg, value) Then
checkGrade = True
Else
checkGrade = False
End If
End Function
Function checkXJH(value)
Dim reg
reg = "^\d{4}[0-7]\d{3}[0-3]\d{7}$"
If regCheckFunc(reg, value) Then
checkXJH = True
Else
checkXJH = False
End If
End Function
Function checkPhoneNum(value)
Dim reg
reg = "\b((1(([38]\d)|(4[57])|(5[0-35-9]))\d{8})|(0((10)|(2[\d]))-[2-9]\d*)|(0[3-9]\d{2}-[2-9]\d*))\b"
If regCheckFunc(reg, value) Then
checkPhoneNum = True
Else
checkPhoneNum = False
End If
End Function
Function checkBank(value)
Dim reg
reg = "^[1-9]\d{15,18}$"
If regCheckFunc(reg, value) Then
checkBank = True
Else
checkBank = False
End If
End Function
Function checkSchoolYear(value)
Dim reg
Dim years
reg = "^20\d{2}-20\d{2}$"
If regCheckFunc(reg, value) Then
years = Split(value, "-")
If years(1) - years(0) = 1 Then
checkSchoolYear = True
Else
checkSchoolYear = False
End If
Else
checkSchoolYear = False
End If
End Function
Function checkOption(value1, value2)
If value1 = "" Then
checkOption = True
Exit Function
End If
If Len(value1) > value2 Then
checkOption = False
Else
checkOption = True
End If
End Function
Function compare(value1, value2)
value1 = CInt(value1)
value2 = CInt(value2)
If value1 > value2 Then
compare = False
Else
compare = True
End If
End Function
Function compareDec(value1, value2)
value1 = CDec(value1)
value2 = CDec(value2)
If value1 > value2 Then
compareDec = False
Else
compareDec = True
End If
End Function
Function checkSzdcxlx(value, value1)
checkSzdcxlx = checkDMB(value, value1)
End Function
Function checkSF(value, value1)
checkSF = checkDMB(value, value1)
End Function
Function checkGender(value, value1)
checkGender = checkDMB(value, value1)
End Function
Function checkSfzjlx(value, value1)
checkSfzjlx = checkDMB(value, value1)
End Function
Function checkMZ(value, value1)
checkMZ = checkDMB(value, value1)
End Function
Function checkHKXZ(value, value1)
checkHKXZ = checkDMB(value, value1)
End Function
Function checkBJLB(value, value1)
checkBJLB = checkDMB(value, value1)
End Function
Function checkZZFS(value, value1)
checkZZFS = checkDMB(value, value1)
End Function
Function checkTerm(value, value1)
checkTerm = checkDMB(value, value1)
End Function
Function checkMoney(value)
Dim reg
reg = "^(([1-9](\d{0,3})|0)|0)$"
If regCheckFunc(reg, value) Then
checkMoney = True
Else
checkMoney = False
End If
End Function
Function checkMoneyTJ(value)
Dim reg
reg = "^[1-9]\d{0,7}$"
If regCheckFunc(reg, value) Then
checkMoneyTJ = True
Else
checkMoneyTJ = False
End If
End Function
Function checkPersonNum(value)
Dim reg
reg = "^(([1-9]\d{0,3}))$"
If regCheckFunc(reg, value) Then
checkPersonNum = True
Else
checkPersonNum = False
End If
End Function
Function checkIdNumLink(IdNum, rowIndex, colIndex)
Dim isGenderRight As Boolean
Dim isBirthRight As Boolean
Dim length2 As Integer
Dim genderValue As String
Dim genderValue1 As Integer
Dim birthValue As String
Dim birthValue1 As String
Dim year, year1 As Variant
Dim month, month1 As Variant
Dim day, day1 As Variant
Dim arr
genderValue = Sheets(sheetNameValue1).Cells(rowIndex, babyGenderColumn)
genderValue = Trim(genderValue)
genderValue1 = Mid(IdNum, 17, 1)
birthValue = Sheets(sheetNameValue1).Cells(rowIndex, babyBirthdayColumn)
birthValue1 = Mid(IdNum, 7, 8)
If genderValue = "" Then
If genderValue1 Mod 2 = 1 Then
Sheets(sheetNameValue1).Cells(rowIndex, babyGenderColumn) = "男"
isGenderRight = True
Else
Sheets(sheetNameValue1).Cells(rowIndex, babyGenderColumn) = "女"
isGenderRight = True
End If
Else
If genderValue = "男" And genderValue1 Mod 2 = 1 Then
isGenderRight = True
ElseIf genderValue = "女" And genderValue1 Mod 2 = 0 Then
isGenderRight = True
Else
isGenderRight = False
End If
End If
birthValue = Trim(birthValue)
If birthValue = "" Then
year = Mid(birthValue1, 1, 4)
month = Mid(birthValue1, 5, 2)
day = Mid(birthValue1, 7, 2)
Sheets(sheetNameValue1).Cells(rowIndex, babyBirthdayColumn) = year + "/" + month + "/" + day
isBirthRight = True
Else
arr = Split(birthValue, "/")
If UBound(arr) > 0 Then
Else
isBirthRight = False
Exit Function
End If
year = arr(0)
month = arr(1)
day = arr(2)
If CDec(month) < 10 Then
birthValue = year & "0" & CDec(month)
Else
birthValue = year & "" & month
End If
If CDec(day) < 10 Then
birthValue = birthValue & "0" & CDec(day)
Else
birthValue = birthValue & "" & day
End If
If birthValue = birthValue1 Then
isBirthRight = True
Else
isBirthRight = False
End If
End If
If isGenderRight And isBirthRight Then
checkIdNumLink = True
Else
checkIdNumLink = False
End If
End Function

Attribute VB_Name = "主程序"
Sub 测试统计表中规则()
End Sub
Sub 测试所有校验规则并打印错误信息()
Dim titleMsg$, errorMsgZZBZ$, rowDataNum%
Dim typeValue
Dim bsType
Dim valEntity
Dim val
Dim typeRow
Dim isNullRowArr(500) As Integer
Sheets(msgSheetName).Cells.ClearContents
curMsgRow = 1
hasError = False
hasErrorTJ = False
Application.ScreenUpdating = False
Sheets(msgSheetName).Cells.ClearContents
rna = Sheets(sheetNameValue1).Range("A65530").End(xlUp).Row
cna = Sheets(sheetNameValue1).Range("8:8").Find(What:="*", After:=[a8], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
setCellValueXQ AreaSheetName, 41, 8, "0"
totalMoneySum = 0
baojiaoMoneySum = 0
huoshiMoneySum = 0
zhusuMoneySum = 0
othersMoneySum = 0
avgMoney = 0
isNullRowNum = 0
If isSaveButton = vbOK Then
Else
If MsgBox("您确定开始检查吗？ 检查过程中，请勿关闭excel，" & Chr(10) & "否则可能导致数据丢失或检查失败", vbOKCancel, "温馨提示") = vbOK Then
Else
Exit Sub
End If
End If
Cells.Hyperlinks.Delete
Sheets(sheetNameValue1).Tab.ColorIndex = -4142
setCellValueXQ sheetNameValueTJ, sheet2RecordNum, ffTotalNumColumn, 0
setCellValueXQ sheetNameValueTJ, sheet2RecordNum, totalMoneyColumnTJ, totalMoneySum
setCellValueXQ sheetNameValueTJ, sheet2RecordNum, baojiaoMoneyColumnTJ, baojiaoMoneySum
setCellValueXQ sheetNameValueTJ, sheet2RecordNum, huoshiMoneyColumnTJ, huoshiMoneySum
setCellValueXQ sheetNameValueTJ, sheet2RecordNum, zhusuMoneyColumnTJ, zhusuMoneySum
setCellValueXQ sheetNameValueTJ, sheet2RecordNum, othersMoneyColumnTJ, othersMoneySum
setCellValueXQ sheetNameValueTJ, sheet2RecordNum, avgMoneyColumnTJ, avgMoney
Set headIndexCol = Sheets(sheetNameValue1).Range("IV3").End(xlToLeft)
For columnIndex = 2 To headIndexCol.Column + 1
If columnIndex Mod 2 = 1 Then
typeValue = Sheets(sheetNameValue1).Cells(1, columnIndex).value
isFor = False
…

Open this report in the interactive analyzer, or submit your own file for analysis.