[原]Excel VBA数据校验

'==============================================================
'需求描述:  新表拿过来，要核对姓名和帐号是否与原始表中一致，
'                  姓名不一致就要标出姓名不一致，帐号不一致就标出帐号不一致
'程序功能:以母表为基础，校对子表的数据
'完成时间:2012-02-17
'Author: wintys(wintys@gmail.com) http://wintys.cnblogs.com
'==============================================================
''全局设置及函数声明

'声明函数GetTickCount用于获取自windows启动以来经历的时间长度（毫秒）
Private Declare Function GetTickCount Lib "kernel32" () As Long

Option Explicit '强制声明

'Option Compare 语句为模块指定字符串比较的方法（Binary、Text 或 Database）。
'如果模块中没有 Option Compare 语句，则缺省的文本比较方法是 Binary。Find()方法中用到了比较
Option Compare Text

Option Base 1 '数组下标从1开始
'==============================================================
'★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
'''''''''''''''''''''''五角星包以下是程序参数，可以根据实际情况修改''''''''''''''''''''''''''''
'★交付客户使用时，一定要关闭调试模式，切记！★
#Const DEBUG_MODE = False                    '是否开启调试模式。True:开启，False:关闭


'【常量设置】

'Sheet1、2、3的实际名称可以改，但是必须与程序中此处名称一致。
Public Const SHEET1_NAME = "Base"
Public Const SHEET2_NAME = "Target"
Public Const SHEET3_NAME = "Result"

Public Const SHEET2_RESULT_FILE = SHEET2_NAME & "_result.txt" 'Sheet2生成的文本的文件名
Public Const SHEET3_RESULT_FILE = SHEET3_NAME & "_result.txt" 'Sheet3生成的文本的文件名

'表1相关设置
Const a_NAME_INDEX = 2                                  '姓名所在列
Const a_ACCOUNT_INDEX = 1                            '账号所在列

'表2相关设置
Const b_NAME_INDEX = 2                                  '姓名所在列
Const b_ACCOUNT_INDEX = 4                            '账号所在列
Const b_AMOUNT_INDEX = 3                             '金额所在列
Public Const b_RESULT_NAME_INDEX = 5            '修正结果的姓名所在列,btnClearContent_Click()使用了，所以要Public
Public Const b_RESULT_ACCOUNT_INDEX = 6       '修正结果的账号所在列
Const b_BEGIN_COL_INDEX = 1                         'Sheet2起始数据列
Const b_END_COL_INDEX = 4                            'Sheet2数据列结尾

'表3相关设置
Const c_NAME_INDEX = 2
Const c_ACCOUNT_INDEX = 1
Const c_AMOUNT_INDEX = 3                              '金额所在列
Const c_BEGIN_COL_INDEX = 1
Const c_END_COL_INDEX = 3
Public Const c_RESULT_NAME_INDEX = 5
Public Const c_RESULT_ACCOUNT_INDEX = 4
Public Const c_RESULT_AMOUNT_INDEX = 6        '修正结果的金额所在列


'颜色设置:3为红色、6为黄色、7为紫色
Const COLOR_ERROR = 3                                       '数据错误时的提示颜色
Const COLOR_DUPLICATE = 6                                '数据行重复的提示颜色
Const COLOR_NOT_MATCHED = 7                           '数据不匹配时的提示颜色

'提示信息设置
Const INFO_NOT_MATCHED = "【Not Matched】"                       ' "事后比对"所用到的提示信息
Const INFO_AMOUNT = "Amount:"                                         ' "事后比对"所用到的提示信息
Const INFO_AMOUNT_UNAVAILABLE = "【Amount Unavailable】"
Const INFO_DATA_ERROR = "【Account and Name do not Exist】"           ' "事后比对"所用到的提示信息
Const INFO_DUPLICATE_NAME = "【Duplicate Name"                   ' "开始检验"所用到的提示信息
Const INFO_DUPLICATE_ACCOUNT = "【Duplicate Account"            ' "开始检验"所用到的提示信息
Const INFO_DUPLICATE_TIMES = "Times】"                         '  "开始检验"所用到的提示信息

Const DUPLICATE_MAX = 100                                  'FindDuplicateCounts查找时最大重复次数，以防意外的死循环

#If DEBUG_MODE = True Then
Const ARRAY_SIZE = 5
#Else
Const ARRAY_SIZE = 50
#End If
'★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
'=========================================================
'全局变量
Public arr() As Long, arr_index As Long, arr_size As Long

'=========================================================
'数据事前校验
Sub DataValidation()
    Dim a_rows As Long, b_rows As Long, a_headerRow As Long, b_headerRow As Long
    Dim j As Long, k As Long, index As Long
    Dim b_name As String, b_account As String
    Dim state As Integer
    Dim Sheet1 As Worksheet, Sheet2 As Worksheet
    Dim nameRange As range, accRange As range
    Dim row_name As Long, row_account As Long, cnt_name As Long, cnt_account As Long
    Dim col_outter As Long, col_inner As Long, col_a As Long
    Dim a_cell_str As String, b_cell_str As String
    
    #If DEBUG_MODE = True Then
    Dim timeConsumeBegin As Long, timeSpan As Long
    timeConsumeBegin = GetTickCount
    #Else
    On Error Resume Next
    #End If

    Set Sheet1 = Worksheets(SHEET1_NAME)
    Set Sheet2 = Worksheets(SHEET2_NAME)
    
    Application.ScreenUpdating = False '屏蔽刷屏
    Sheet2.Activate
    CleanSheet Sheet2, b_RESULT_NAME_INDEX, b_RESULT_ACCOUNT_INDEX

    '数组初始化
    InitArray
    '标题行只能用眼睛看，用ListHeaderRows 只读属性判断并不一定准确
    'a_headerRow = sheet1.Range("A1").CurrentRegion.ListHeaderRows
    'b_headerRow = sheet2.Range("A1").CurrentRegion.ListHeaderRows
    '用ListHeaderRows不一定准确，所以硬编码
    a_headerRow = 0
    b_headerRow = 0
    a_rows = Sheet1.range("A1").CurrentRegion.Rows.Count
    b_rows = Sheet2.range("A1").CurrentRegion.Rows.Count
    'b_rows = b_rows - 1 '去掉Sheet2合计行
    
    For j = b_headerRow + 1 To b_rows 'b_headerRow + 1:去掉表头
        b_name = Sheet2.Cells(j, b_NAME_INDEX).Value
        b_account = Sheet2.Cells(j, b_ACCOUNT_INDEX).Value
        
        '针对表2为空表的情况
        If b_name = "" And b_account = "" And b_rows = 1 Then Exit For
          
        '数组扩容
        ExpandArray
        
        state = 0
        cnt_name = 0
        cnt_account = 0
        
        ''查找姓名及其重复出现次数
        Set nameRange = Sheet1.Cells.Find(what:=b_name, LookAt:=xlWhole) 'xlWhole:搜索选项"单元格匹配"
        If Not nameRange Is Nothing Then
            state = state Or &H1
            row_name = nameRange.Rows.Row
            cnt_name = FindDuplicateCounts(targetRange:=Sheet1.Cells, what:=b_name, resultRange:=nameRange)
        End If
        
        ''查找姓名及其重复出现次数
        Set accRange = Sheet1.Cells.Find(what:=b_account, LookAt:=xlWhole)
        If Not accRange Is Nothing Then
            state = state Or &H2
            row_account = accRange.Rows.Row
            cnt_account = FindDuplicateCounts(targetRange:=Sheet1.Cells, what:=b_account, resultRange:=accRange)
        End If
        
        #If DEBUG_MODE = True Then
        Debug.Print "[" & j & "]name:" & cnt_name & " account:" & cnt_account
        #End If
        
        Select Case state
            Case 0 '姓名与账号都没有找到
                Sheet2.range(Cells(j, b_BEGIN_COL_INDEX), Cells(j, b_END_COL_INDEX)).Interior.ColorIndex _
                    = COLOR_ERROR
                '姓名与账号在母表中均未找到，没有正确数据可以供校正
                Sheet2.Cells(j, b_RESULT_NAME_INDEX).Value = INFO_DATA_ERROR
                
                '记录行号到数组
                AddToArray j
            Case 1 '姓名找到了，账号没找到了
                Sheet2.Cells(j, b_ACCOUNT_INDEX).Interior.ColorIndex = COLOR_ERROR
                Sheet2.Cells(j, b_RESULT_ACCOUNT_INDEX).Value _
                    = Sheet1.Cells(row_name, a_ACCOUNT_INDEX).Value '修正建议
                
                '记录行号到数组
                AddToArray j
            Case 2 '姓名没找到，账号找到了
                Sheet2.Cells(j, b_NAME_INDEX).Interior.ColorIndex = COLOR_ERROR
                Sheet2.Cells(j, b_RESULT_NAME_INDEX).Value _
                    = Sheet1.Cells(row_account, a_NAME_INDEX).Value '修正建议
                
                '记录行号到数组
                AddToArray j
            Case 3 '姓名与账号都找到了
                '如果姓名与账户都在Sheet1中找到了，还可能存在不匹配的情况
                If row_name <> row_account And cnt_name = 1 And cnt_account = 1 Then
                    Sheet2.range(Cells(j, b_BEGIN_COL_INDEX), Cells(j, b_END_COL_INDEX)).Interior.ColorIndex _
                        = COLOR_NOT_MATCHED
                        
                    '记录行号到数组
                    AddToArray j
                    
                    #If DEBUG_MODE = True Then
                    Debug.Print "index=" & index & " name:" & row_name & " acc:" & row_account
                    #End If
                    
                    If row_name > row_account Then '先找到匹配的account
                        col_outter = b_RESULT_NAME_INDEX
                        col_inner = b_RESULT_ACCOUNT_INDEX
                        col_a = a_NAME_INDEX
                        b_cell_str = b_name
                    Else '先找到匹配的name
                        col_outter = b_RESULT_ACCOUNT_INDEX
                        col_inner = b_RESULT_NAME_INDEX
                        col_a = a_ACCOUNT_INDEX
                        b_cell_str = b_account
                    End If
                    
                    #If DEBUG_MODE = True Then
                    Debug.Print "j=" & j & " col_outter:" & col_outter & " col_inner:" & col_inner
                    #End If
                    
                    '行号小的那一项是先找到的，所以先从它开始
                    index = IIf(row_name > row_account, row_account, row_name)
                    Sheet2.Cells(j, col_outter).Value _
                        = Sheet1.Cells(index, a_NAME_INDEX).Value & ":" & Sheet1.Cells(index, a_ACCOUNT_INDEX).Value
                    
                    '姓名在第一次搜索中没有记录下来，进行第二次搜索(从i开始搜索)，把它找到。
                    For k = index + 1 To a_rows
                        a_cell_str = Sheet1.Cells(k, col_a).Value
                        
                        If b_cell_str = a_cell_str Then
                            Sheet2.Cells(j, col_inner).Value _
                                = Sheet1.Cells(k, a_NAME_INDEX).Value & ":" & Sheet1.Cells(k, a_ACCOUNT_INDEX).Value
                            Exit For
                        End If
                    Next k
                End If
                
                '姓名或账号有重名
                If cnt_name > 1 Or cnt_account > 1 Then
                    Sheet2.range(Cells(j, b_BEGIN_COL_INDEX), Cells(j, b_END_COL_INDEX)).Interior.ColorIndex _
                        = COLOR_DUPLICATE
                        
                    '记录行号到数组
                    AddToArray j
                    
                    '姓名重复
                    If cnt_name > 1 Then
                        Sheet2.Cells(j, b_RESULT_NAME_INDEX).Value _
                            = INFO_DUPLICATE_NAME & cnt_name & INFO_DUPLICATE_TIMES
                    End If
                    
                    '账号重复
                    If cnt_account > 1 Then
                        Sheet2.Cells(j, b_RESULT_ACCOUNT_INDEX).Value _
                            = INFO_DUPLICATE_ACCOUNT & cnt_account & INFO_DUPLICATE_TIMES
                    End If
                End If
        End Select
    Next j

    '调整列宽
    Sheet2.range(GetColumnStr(b_RESULT_NAME_INDEX)).Columns.AutoFit
    Sheet2.range(GetColumnStr(b_RESULT_ACCOUNT_INDEX)).Columns.AutoFit
    
    Application.ScreenUpdating = True  '开启刷屏
    
    '写入文件
    WriteToFile Sheet2, ThisWorkbook.Path & "\" & SHEET2_RESULT_FILE, _
        b_BEGIN_COL_INDEX, b_END_COL_INDEX, b_RESULT_NAME_INDEX, b_RESULT_ACCOUNT_INDEX
    
    Set Sheet1 = Nothing
    Set Sheet2 = Nothing
    Set nameRange = Nothing
    Set accRange = Nothing
    frmValidation.Hide
        
    #If DEBUG_MODE = False Then
        MsgBox "Validation Complete！"
    #Else
        timeSpan = GetTickCount - timeConsumeBegin
        Debug.Print "事前校验耗时:" & timeSpan & "ms"
        Debug.Print "==============="
    #End If
End Sub
'=========================================================
'数据事后校验:复制于DataValidation(),稍加改动
Sub DataValidationAfterwards()
    Dim a_rows As Long, b_rows As Long '行数
    Dim a_headerRow As Long, b_headerRow As Long
    Dim j As Long, k As Long
    Dim b_name As String, b_account As String
    Dim state As Integer
    Dim Sheet1 As Worksheet, Sheet2 As Worksheet
    Dim cnt_name As Long, cnt_account As Long
    Dim nameRange As range, accRange As range
    Dim index As Long
    Dim row_name As Long, row_account As Long
    Dim col_outter As Long, col_inner As Long, col_a As Long
    Dim a_cell_str As String, b_cell_str As String
    
    Dim b_amount As Double, c_amount As Double
    
    #If DEBUG_MODE = True Then
    Dim timeConsumeBegin As Long, timeSpan As Long
    timeConsumeBegin = GetTickCount
    #Else
    On Error Resume Next
    #End If
    
    Set Sheet1 = Worksheets(SHEET2_NAME)
    Set Sheet2 = Worksheets(SHEET3_NAME)
    
    Application.ScreenUpdating = False '屏蔽刷屏
    Sheet2.Activate
    CleanSheet Sheet2, c_RESULT_NAME_INDEX, c_RESULT_ACCOUNT_INDEX
    CleanSheet Sheet2, c_RESULT_AMOUNT_INDEX

    '数组初始化
    InitArray
    
    '标题行只能用眼睛看，用ListHeaderRows 只读属性判断并不一定准确
    'a_headerRow = sheet1.Range("A1").CurrentRegion.ListHeaderRows
    'b_headerRow = sheet2.Range("A1").CurrentRegion.ListHeaderRows
    '用ListHeaderRows不一定准确，所以硬编码
    a_headerRow = 0
    b_headerRow = 0
    a_rows = Sheet1.range("A1").CurrentRegion.Rows.Count
    b_rows = Sheet2.range("A1").CurrentRegion.Rows.Count
    'b_rows = b_rows - 1 '去掉Sheet2合计行
    
    For j = b_headerRow + 1 To b_rows 'b_headerRow + 1:去掉表头
        b_name = Sheet2.Cells(j, c_NAME_INDEX).Value
        b_account = Sheet2.Cells(j, c_ACCOUNT_INDEX).Value
        c_amount = Val(Sheet2.Cells(j, c_AMOUNT_INDEX).Value)
        
        '针对表2为空表的情况
        If b_name = "" And b_account = "" And b_rows = 1 Then Exit For
          
        '数组扩容
        ExpandArray
        
        state = 0
        cnt_name = 0
        cnt_account = 0
        
        ''查找姓名及其重复出现次数
        Set nameRange = Sheet1.Cells.Find(what:=b_name, LookAt:=xlWhole) 'xlWhole:搜索选项"单元格匹配"
        If Not nameRange Is Nothing Then
            state = state Or &H1
            row_name = nameRange.Rows.Row
            cnt_name = FindDuplicateCounts(targetRange:=Sheet1.Cells, what:=b_name, resultRange:=nameRange)
        End If
        
        ''查找姓名及其重复出现次数
        Set accRange = Sheet1.Cells.Find(what:=b_account, LookAt:=xlWhole)
        If Not accRange Is Nothing Then
            state = state Or &H2
            row_account = accRange.Rows.Row
            cnt_account = FindDuplicateCounts(targetRange:=Sheet1.Cells, what:=b_account, resultRange:=accRange)
        End If
        
        Select Case state
            Case 0 '姓名与账号都没有找到
                Sheet2.range(Cells(j, c_BEGIN_COL_INDEX), Cells(j, c_END_COL_INDEX)).Interior.ColorIndex _
                    = COLOR_ERROR
                '姓名与账号在母表中均未找到，没有正确数据可以供校正
                Sheet2.Cells(j, c_RESULT_NAME_INDEX).Value = INFO_DATA_ERROR
                
                '记录行号到数组
                AddToArray j
            Case 1 '姓名找到了，账号没找到了
                Sheet2.Cells(j, c_ACCOUNT_INDEX).Interior.ColorIndex = COLOR_ERROR
                Sheet2.Cells(j, c_RESULT_ACCOUNT_INDEX).Value _
                    = Sheet1.Cells(row_name, b_ACCOUNT_INDEX).Value '修正建议
                
                b_amount = Val(Sheet1.Cells(row_name, c_AMOUNT_INDEX).Value)
                If b_amount <> c_amount Then
                    Sheet2.Cells(j, c_AMOUNT_INDEX).Interior.ColorIndex = COLOR_ERROR
                    Sheet2.Cells(j, c_RESULT_AMOUNT_INDEX).Value _
                        = INFO_AMOUNT & Sheet1.Cells(row_name, b_AMOUNT_INDEX).Value '修正建议
                End If
                
                '记录行号到数组
                AddToArray j
            Case 2 '姓名没找到，账号找到了
                Sheet2.Cells(j, c_NAME_INDEX).Interior.ColorIndex = COLOR_ERROR
                Sheet2.Cells(j, c_RESULT_NAME_INDEX).Value _
                    = Sheet1.Cells(row_account, b_NAME_INDEX).Value '修正建议
                
                b_amount = Val(Sheet1.Cells(row_account, c_AMOUNT_INDEX).Value)
                If b_amount <> c_amount Then
                    Sheet2.Cells(j, c_AMOUNT_INDEX).Interior.ColorIndex = COLOR_ERROR
                    Sheet2.Cells(j, c_RESULT_AMOUNT_INDEX).Value _
                        = INFO_AMOUNT & Sheet1.Cells(row_account, b_AMOUNT_INDEX).Value '修正建议
                        
                    '记录行号到数组
                    AddToArray j
                End If
                
                '记录行号到数组
                AddToArray j
            Case 3 '姓名与账号都找到了
                '如果姓名与账户都在Sheet1中找到了，还可能存在不匹配的情况
                If row_name <> row_account And cnt_name = 1 And cnt_account = 1 Then
                    Sheet2.range(Cells(j, c_BEGIN_COL_INDEX), Cells(j, c_END_COL_INDEX)).Interior.ColorIndex _
                        = COLOR_NOT_MATCHED
                    
                    '不匹配时的情况
                    Sheet2.Cells(j, c_RESULT_AMOUNT_INDEX).Value = INFO_AMOUNT_UNAVAILABLE   '修正金额
                        
                    '记录行号到数组
                    AddToArray j
                    
                    If row_name > row_account Then '先找到匹配的account
                        col_outter = c_RESULT_NAME_INDEX
                        col_inner = c_RESULT_ACCOUNT_INDEX
                        col_a = b_NAME_INDEX
                        b_cell_str = b_name
                    Else '先找到匹配的name
                        col_outter = c_RESULT_ACCOUNT_INDEX
                        col_inner = c_RESULT_NAME_INDEX
                        col_a = b_ACCOUNT_INDEX
                        b_cell_str = b_account
                    End If
                        
                    '行号小的那一项是先找到的，所以先从它开始
                    index = IIf(row_name > row_account, row_account, row_name)
                    Sheet2.Cells(j, col_outter).Value _
                        = Sheet1.Cells(index, b_NAME_INDEX).Value & ":" & Sheet1.Cells(index, b_ACCOUNT_INDEX).Value
                    
                    '姓名在第一次搜索中没有记录下来，进行第二次搜索(从i开始搜索)，把它找到。
                    For k = index + 1 To a_rows
                        a_cell_str = Sheet1.Cells(k, col_a).Value
                        
                        If b_cell_str = a_cell_str Then
                            Sheet2.Cells(j, col_inner).Value _
                                = Sheet1.Cells(k, b_NAME_INDEX).Value & ":" & Sheet1.Cells(k, b_ACCOUNT_INDEX).Value
                            Exit For
                        End If
                    Next k
                Else
                    b_amount = Val(Sheet1.Cells(row_name, c_AMOUNT_INDEX).Value)
                    If b_amount <> c_amount Then
                        Sheet2.Cells(j, c_AMOUNT_INDEX).Interior.ColorIndex = COLOR_ERROR
                        Sheet2.Cells(j, c_RESULT_AMOUNT_INDEX).Value _
                            = INFO_AMOUNT & Sheet1.Cells(row_name, b_AMOUNT_INDEX).Value '修正建议
                    End If
                End If
                
                '姓名或账号有重名
                If cnt_name > 1 Or cnt_account > 1 Then
                    Sheet2.range(Cells(j, c_BEGIN_COL_INDEX), Cells(j, c_END_COL_INDEX)).Interior.ColorIndex _
                       = COLOR_DUPLICATE
                        
                    '记录行号到数组
                    AddToArray j
                    
                    '姓名重复
                    If cnt_name > 1 Then
                        Sheet2.Cells(j, c_RESULT_NAME_INDEX).Value _
                            = INFO_DUPLICATE_NAME & cnt_name & INFO_DUPLICATE_TIMES
                    End If
                    
                    '账号重复
                    If cnt_account > 1 Then
                        Sheet2.Cells(j, c_RESULT_ACCOUNT_INDEX).Value _
                           = INFO_DUPLICATE_ACCOUNT & cnt_account & INFO_DUPLICATE_TIMES
                    End If
                End If
        End Select
    Next j

    '调整列宽
    Sheet2.range(GetColumnStr(c_RESULT_NAME_INDEX)).Columns.AutoFit
    Sheet2.range(GetColumnStr(c_RESULT_ACCOUNT_INDEX)).Columns.AutoFit
    Sheet2.range(GetColumnStr(c_RESULT_AMOUNT_INDEX)).Columns.AutoFit
    
    Application.ScreenUpdating = True  '开启刷屏
    
    '写入文件
    WriteToFile Sheet2, ThisWorkbook.Path & "\" & SHEET3_RESULT_FILE, _
        c_BEGIN_COL_INDEX, c_END_COL_INDEX, c_RESULT_ACCOUNT_INDEX, c_RESULT_AMOUNT_INDEX
    
    Set Sheet1 = Nothing
    Set Sheet2 = Nothing
    Set nameRange = Nothing
    Set accRange = Nothing
    frmValidation.Hide
        
    #If DEBUG_MODE = False Then
        MsgBox "Validation Complete！"
    #Else
        timeSpan = GetTickCount - timeConsumeBegin
        Debug.Print "事后校验耗时:" & timeSpan & "ms"
        Debug.Print "==============="
    #End If
End Sub
'=========================================================
'清除颜色和结果数据
Sub CleanSheet(sheet As Worksheet, Optional colIndex1 As Long, Optional colIndex2 As Long)
    Dim column1 As String, column2 As String
    
    '清除sheet的颜色
    sheet.range("A1").CurrentRegion.Interior.ColorIndex = 0
    
    '如果colIndex1参数没有被省略
    If colIndex1 <> 0 Then
        column1 = GetColumnStr(colIndex1)
        sheet.range(column1).Clear '清空数据
        sheet.range(column1).NumberFormatLocal = "@" '设置正确结果建议行格式为文本
    End If
    
    If colIndex2 <> 0 Then
        column2 = GetColumnStr(colIndex2)
        sheet.range(column2).Clear
        sheet.range(column2).NumberFormatLocal = "@"
    End If
End Sub
'例如：输入5，A + 5 - 1 = E, 所以返回"E:E"
Private Function GetColumnStr(colIndex As Long) As String
    GetColumnStr = GetColumnChar(colIndex) & ":" & GetColumnChar(colIndex)
End Function
'A=65,GetColumnChar(5)= E
Private Function GetColumnChar(colIndex As Long) As String
    GetColumnChar = Chr(65 + colIndex - 1)
End Function
Private Sub AddToArray(index As Long)
    arr(arr_index) = index
    arr_index = arr_index + 1
End Sub
'数组初始化
Private Sub InitArray()
    arr_index = 1
    arr_size = ARRAY_SIZE
    ReDim arr(arr_size)
End Sub
'数组扩容
Private Sub ExpandArray()
    If arr_index > arr_size / 2 Then
        arr_size = arr_size + ARRAY_SIZE
        ReDim Preserve arr(arr_size)
    End If
End Sub
'=========================================================
'使用FindNext查找,计算查找内容的出现次数
Private Function FindDuplicateCounts(targetRange As range, what As String, resultRange As range) As Long
    Dim firstAddress As String
    Dim cnt As Long
    cnt = 0

    If Not resultRange Is Nothing Then
        firstAddress = resultRange.Address
        Do
            cnt = cnt + 1
            '防止超出最大循环次数
            If cnt > DUPLICATE_MAX Then
                Exit Do
            End If
            Set resultRange = targetRange.FindNext(resultRange)
        Loop While Not resultRange Is Nothing And resultRange.Address <> firstAddress
    End If
    
    FindDuplicateCounts = cnt
End Function

'将不匹配的数据按行写入文件文件
Private Sub WriteToFile(sh As Worksheet, fullPath As String, begin_col As Long, end_col As Long, _
    result_begin_col As Long, Optional result_end_col As Long)
    Dim fs, f
    Dim i As Long, m As Long
    Dim str As String
    Dim c As range
    Dim col1 As String, col2 As String, col3 As String, col4 As String, col_str As String
    
    '结果集为空时
    If arr_index = 1 Then Exit Sub
    
    col1 = GetColumnChar(begin_col)
    col2 = GetColumnChar(end_col)
    col3 = GetColumnChar(result_begin_col)
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile(fullPath, 2, True)   '2表示覆盖原有数据
    
    For i = 1 To arr_index - 1
        m = arr(i) '取行号
        str = ""
        
        '显示错误数据行的原始内容
        For Each c In sh.range(col1 & m & ":" & col2 & m)
            str = str & c.Value & ","
        Next c
        
        '根据结果列,构造col_str. col_str可能的结果为:col_str="D3"、col_str="E1:F1"
        If result_end_col = 0 Then
            col_str = col3 & m
        Else
            col4 = GetColumnChar(result_end_col)
            col_str = col3 & m & ":" & col4 & m
        End If
        
        '显示错误数据行的修正结果
        str = str & "("
        For Each c In sh.range(col_str)
            If c <> "" Then str = str & c.Value & ","
        Next c
        str = str & ")"
        
        '写入文件
        f.writeline "[" & m & "]" & str
    Next i

    f.Close
     
    Set f = Nothing
    Set fs = Nothing
End Sub