VBA 两个Excel对比 操作（带进度条）

Option Explicit''数组公共变量Public checkArr() As StringPublic checkContentArr() As StringSub checkFileText()    ''关闭屏幕切换    Application.ScreenUpdating = False    Application.DisplayAlerts = False    Dim excel1 As Workbook, excel2 As Workbook                       ''两个EXCEL对象        Dim strPath As String, strCheckPath As String                    ''EXCEL路径变量        Dim officialCnt As Long, tryCnt As Long, practiceCnt As Long, _        contractCnt As Long, temporaryCnt As Long                    ''最大数            Dim checkCnt As Long                                             ''最大行数        Dim rowCount As Long, i As Long, j As Long, k As Long, m As Long    ''计数器    ''获取路径值    strPath = Sheets(1).Range("C2").Value & ""    strCheckPath = Sheets(1).Range("C3").Value & ""    ''检测文件是否存在    If Not FileExists(strPath) Then        MsgBox "路径1文件不存在！"        Exit Sub    End If    If Not FileExists(strCheckPath) Then        MsgBox "路径2文件不存在！"        Exit Sub    End If    ''获得EXCEL对象    Set excel1 = Workbooks.Open(strPath)    Set excel2 = Workbooks.Open(strCheckPath)    ''获取五类员工的最大行数    officialCnt = excel1.Sheets(1).[b65536].End(xlUp).Row - 5 ''根据实际格式调整    tryCnt = excel1.Sheets(1).[i65536].End(xlUp).Row - 5    practiceCnt = excel1.Sheets(1).[p65536].End(xlUp).Row - 5    contractCnt = excel1.Sheets(1).[x65536].End(xlUp).Row - 5    temporaryCnt = excel1.Sheets(1).[ae65536].End(xlUp).Row - 5    ''获取excel2的最大行数    checkCnt = excel2.Sheets(1).[a65536].End(xlUp).Row - 1 ''根据实际格式调整    ''显示进度条    prgramBarShow.Show 0    ''按任务完成情况百分比设置lblProgress的宽度，实现模拟效果    prgramBarShow.lblprogerss.Width = prgramBarShow.lblBack.Width / _                                      (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * 1    ''格式化显示完成任务情况的百分比    prgramBarShow.percert = Format(1 / 100 * 1, "0") & "%"    ''将进度条自身进度重绘操作，实现显示更新情况    prgramBarShow.Repaint    ''加载各个Excel数据    ''加载检查样本数据    rowCount = 0    For i = 0 To checkCnt        ReDim Preserve checkArr(rowCount + 1)        ReDim Preserve checkContentArr(rowCount + 1)        checkArr(rowCount) = excel2.Sheets(1).Range("A" & (rowCount + 2))        checkContentArr(rowCount) = excel2.Sheets(1).Range("B" & (rowCount + 2))        rowCount = rowCount + 1    Next    prgramBarShow.lblprogerss.Width = prgramBarShow.lblBack.Width / _                                      (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * checkCnt    prgramBarShow.percert = Format(checkCnt / _                                   (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * 100, "0") & "%"    prgramBarShow.Repaint    ''加载并处理正式社员单元格数据    rowCount = 0    For i = 1 To officialCnt        k = 0        For j = 1 To checkCnt            If checkArr(k) = excel1.Sheets(1).Range("B" & (rowCount + 6)) Then                If checkContentArr(k) <> excel1.Sheets(1).Range("C" & (rowCount + 6)) Then                    excel1.Sheets(1).Range("B" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                    excel1.Sheets(1).Range("C" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                End If            End If            k = k + 1        Next        rowCount = rowCount + 1    Next    prgramBarShow.lblprogerss.Width = prgramBarShow.lblBack.Width / _                                      (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * (checkCnt + officialCnt)    prgramBarShow.percert = Format((checkCnt + officialCnt) / _                                   (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * 100, "0") & "%"    prgramBarShow.Repaint    ''加载并处理试用社员单元格数据    rowCount = 0    For i = 1 To tryCnt        k = 0        For j = 1 To checkCnt            If checkArr(k) = excel1.Sheets(1).Range("I" & (rowCount + 6)) Then                If checkContentArr(k) <> excel1.Sheets(1).Range("J" & (rowCount + 6)) Then                    excel1.Sheets(1).Range("I" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                    excel1.Sheets(1).Range("J" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                End If            End If            k = k + 1        Next        rowCount = rowCount + 1    Next    prgramBarShow.lblprogerss.Width = prgramBarShow.lblBack.Width / _                                      (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * _                                      (checkCnt + officialCnt + tryCnt)    prgramBarShow.percert = Format((checkCnt + officialCnt + tryCnt) / _                                   (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * 100, "0") & "%"    prgramBarShow.Repaint    ''加载并处理实习学生单元格数据    rowCount = 0    For i = 1 To practiceCnt        k = 0        For j = 1 To checkCnt            If checkArr(k) = excel1.Sheets(1).Range("P" & (rowCount + 6)) Then                If checkContentArr(k) <> excel1.Sheets(1).Range("Q" & (rowCount + 6)) Then                    excel1.Sheets(1).Range("P" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                    excel1.Sheets(1).Range("Q" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                End If            End If            k = k + 1        Next        rowCount = rowCount + 1    Next    prgramBarShow.lblprogerss.Width = prgramBarShow.lblBack.Width / _                                      (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * _                                      (checkCnt + officialCnt + tryCnt + practiceCnt)    prgramBarShow.percert = Format((checkCnt + officialCnt + tryCnt + practiceCnt) / _                                   (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * 100, "0") & "%"    prgramBarShow.Repaint    ''加载并处理契约社员单元格数据    rowCount = 0    For i = 1 To contractCnt        k = 0        For j = 1 To checkCnt            If checkArr(k) = excel1.Sheets(1).Range("X" & (rowCount + 6)) Then                If checkContentArr(k) <> excel1.Sheets(1).Range("Y" & (rowCount + 6)) Then                    excel1.Sheets(1).Range("X" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                    excel1.Sheets(1).Range("Y" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                End If            End If            k = k + 1        Next        rowCount = rowCount + 1    Next    prgramBarShow.lblprogerss.Width = prgramBarShow.lblBack.Width / _                                      (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * _                                      (checkCnt + officialCnt + tryCnt + practiceCnt + contractCnt)    prgramBarShow.percert = Format((checkCnt + officialCnt + tryCnt + practiceCnt + contractCnt) / _                                   (officialCnt + tryCnt + practiceCnt + contractCnt + temporaryCnt + checkCnt) * 100, "0") & "%"    prgramBarShow.Repaint    ''加载并处理临时工作人员单元格数据    rowCount = 0    For i = 1 To temporaryCnt        k = 0        For j = 1 To checkCnt            If checkArr(k) = excel1.Sheets(1).Range("AE" & (rowCount + 6)) Then                If checkContentArr(k) <> excel1.Sheets(1).Range("AF" & (rowCount + 6)) Then                    excel1.Sheets(1).Range("AE" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                    excel1.Sheets(1).Range("AF" & (rowCount + 6)).Interior.Color = RGB(100, 860, 35)                End If            End If            k = k + 1        Next        rowCount = rowCount + 1    Next    ''保存文档    excel1.Save    ''进度条    prgramBarShow.lblprogerss.Width = prgramBarShow.lblBack.Width    prgramBarShow.percert = Format(100, "0") & "%"    prgramBarShow.Repaint    ''窗体关闭    prgramBarShow.Hide    ''关闭文档    excel1.Close    excel2.Close    ''恢复屏幕切换    Application.DisplayAlerts = True    Application.ScreenUpdating = TrueEnd Sub''检查文件存在Private Function FileExists(fname) As Boolean'当文件存在时返回true    Dim x As String    x = Dir(fname)    If x <> "" Then FileExists = True Else: FileExists = FalseEnd Function