应用VBA进行Excel表之间的对比查找

  在前面的进行WPS的安装率的统计中,使用两个FOR循环进行安装率的统计需要22秒以上,而使用一个FOR循环仅用了3秒,我是直接更改录制的宏进行程序的编写,后来发现时间只要耗费在sheet之间的跳转,这些是可以避免的。

  也有其他的方法,就是通过if和vlookuo函数来做,但我暂时没有尝试,写程序来得快一些。

  得到表中的行数也不需要录入,直接取值就行了。

  比如:

Set srcSheet = Sheets(1)                      '第一个sheet
Set destSheet = Sheets(3)                     '第三个sheet
iSrcRow = srcSheet.[I65535].End(xlUp).Row     '源表的行数
iDestRow = destSheet.[I65535].End(xlUp).Row   '目标表的行数

  上面也有等价的写法:

Set srcSheet = Sheets("WPS-Office安装记录-新")               '源表sheet
Set destSheet = Sheets("WPS-Office安装记录-前")              '目标表sheet
'得到源表和目标表的总行数
iSrcRow = srcSheet.Cells(Rows.Count, contrastColName).End(xlUp).Row
iDestRow = destSheet.Cells(Rows.Count, contrastColName).End(xlUp).Row

  可以根据个人喜好来选择。

  如果行数特别大,关闭屏幕更新和最小化窗口,等待程序执行完后恢复显示,这样也可以节约时间。

T1 = time()
Application.ScreenUpdating = False '关闭屏幕更新
Application.ActiveWindow.WindowState = xlMinimized    '最小化
......执行程序到完毕
Application.ScreenUpdating = False '开启屏幕更新
Application.ActiveWindow.WindowState = xlMaximized     '最大化
T2 = time()
Application.ScreenUpdating = False '开启屏幕更新
Application.ActiveWindow.WindowState = xlMaximized     '最大化
MsgBox "运行耗时:" + Str(timeDiff(T2, T1)) + " 秒"

  计算时间差函数:

Function timeDiff(T2, T1)
'T2,T1为时间
'转换为秒
Dim second2 As Long
Dim second1 As Long
second2 = Hour(T2) * 3600 + Minute(T2) * 60 + Second(T2)
second1 = Hour(T1) * 3600 + Minute(T1) * 60 + Second(T1)
timeDiff = Abs(second2 - second1)
End Function

  完整程序:

Sub Dawn1029()
'对比两个表的数据列进行检查
Dim iFor As Integer
Dim SYQCY As String
Dim S1, S2, S3, S4, S5, S6 As String
Dim allEquipment As Integer        '设备记录数
Dim ICOUNT As Integer
Dim DuplicateRecord As Integer     '重复记录数
Dim explainTxt As String           '说明文字
Dim installationRate As Single     '安装率
Dim findResult As Range            '检查结果
Dim notInstalled As Integer

T1 = time()
notInstalled = 0
DuplicateRecord = 0

Set srcTable = Sheets("注册总数-新")                      '总设备记录sheet
Set destTable = Sheets("WPS-Office安装记录-新")           'WPS安装记录sheet
allEquipment = srcTable.Cells(Rows.Count, "I").End(xlUp).Row
allWps = destTable.Cells(Rows.Count, "I").End(xlUp).Row

For iFor = 3 To allEquipment
    SYQCY = srcTable.Cells(iFor, "I").Value   '获取MAC地址
    S1 = Left(SYQCY, 2)
    S2 = Mid(SYQCY, 4, 2)
    S3 = Mid(SYQCY, 7, 2)
    S4 = Mid(SYQCY, 10, 2)
    S5 = Mid(SYQCY, 13, 2)
    S6 = Right(SYQCY, 2)
    SYQCY = S1 + S2 + S3 + S4 + S5 + S6
    Set findResult = destTable.Range("I:I").Find(SYQCY)
    If findResult Is Nothing Then
        '没有找到
        notInstalled = notInstalled + 1
        SResult = "没安装"
    Else
        '找到
        SResult = "★"
        '记录找到的次数,大于1就表示是重复的记录,对比MAC地址
        ICOUNT = Val(destTable.Cells(findResult.Row, "K").Value)
        ICOUNT = ICOUNT + 1
        If ICOUNT > 1 Then DuplicateRecord = DuplicateRecord + 1
        destTable.Cells(findResult.Row, "K").Value = ICOUNT
    End If
    srcTable.Cells(iFor, "W").Value = SResult
Next
T2 = time()
allWps = allWps - 2
allEquipment = allEquipment - 2
installationRate = allWps / (allEquipment - DuplicateRecord)
installationRate = Round(installationRate * 100, 2)
explainTxt = "   设备总记录:" + Str(allEquipment)
explainTxt = explainTxt + vbCrLf + "   WPS安装数:" + Str(allWps)
explainTxt = explainTxt + vbCrLf + "   重复记录数:" + Str(DuplicateRecord)
explainTxt = explainTxt + vbCrLf + "   WPS没安装数:" + Str(notInstalled)
explainTxt = explainTxt + vbCrLf + "   实际安装率:" + Str(installationRate) + "%"
explainTxt = explainTxt + vbCrLf + "    运行耗时:" + Str(timeDiff(T2, T1)) + " 秒"
MsgBox explainTxt, , "检查结果 10月30日 19:22"
End Sub
Function timeDiff(T2, T1)
'T2,T1为时间
'转换为秒
Dim second2 As Long
Dim second1 As Long
second2 = Hour(T2) * 3600 + Minute(T2) * 60 + Second(T2)
second1 = Hour(T1) * 3600 + Minute(T1) * 60 + Second(T1)
timeDiff = Abs(second2 - second1)
End Function

  结果显示:

   经过更改后的程序很快就出了结果,当然这也与个人计算机的配置有关。

  后来增加功能,就是统计前后格式相同的两个表的数据变化,比如注册设备记录表,2个小时后有的记录消失了,有的记录是新增加的,要将这些记录找出来。

  以下是完整程序:

Sub dawnCheckWpsInst()
    T1 = time()
    Dim srcMemo, destMemo As String
    '对比检查设备注册表
    srcMemo = contrastSheet("注册总数-新", "注册总数-前", "I", "X")
    '对比检查WPS安装记录表
    destMemo = contrastSheet("WPS-Office安装记录-新", "WPS-Office安装记录-前", "I", "L")
    
    '对比两个表的数据列进行检查:MAC地址(唯一值)
    Dim iFor As Integer
    Dim SYQCY As String
    Dim S1, S2, S3, S4, S5, S6 As String
    Dim allEquipment As Integer        '设备记录数
    Dim DuplicateRecord As Integer     '重复记录数
    Dim explainTxt As String           '说明文字
    Dim installationRate As Single     '安装率
    Dim findResult As Range            '检查结果
    Dim notInstalled As Integer
    Dim ICOUNT As Integer
    
    notInstalled = 0
    DuplicateRecord = 0
    
    Set srcTable = Sheets("注册总数-新")                            '总设备记录sheet
    Set destTable = Sheets("WPS-Office安装记录-新")                 'WPS安装记录sheet
    allEquipment = srcTable.Cells(Rows.Count, "I").End(xlUp).Row    '总设备的记录数
    allWps = destTable.Cells(Rows.Count, "I").End(xlUp).Row         'WPS安装记录数
    
    For iFor = 3 To allEquipment
        SYQCY = srcTable.Cells(iFor, "I").Value   '获取MAC地址
        S1 = Left(SYQCY, 2)
        S2 = Mid(SYQCY, 4, 2)
        S3 = Mid(SYQCY, 7, 2)
        S4 = Mid(SYQCY, 10, 2)
        S5 = Mid(SYQCY, 13, 2)
        S6 = Right(SYQCY, 2)
        SYQCY = S1 + S2 + S3 + S4 + S5 + S6
        Set findResult = destTable.Range("I:I").Find(SYQCY)
        If findResult Is Nothing Then
            '没有找到
            notInstalled = notInstalled + 1
            SResult = "没安装"
        Else
            '找到
            SResult = "★"
            '记录找到的次数,大于1就表示是重复的记录,对比MAC地址
            ICOUNT = Val(destTable.Cells(findResult.Row, "K").Value)
            ICOUNT = ICOUNT + 1
            If ICOUNT > 1 Then DuplicateRecord = DuplicateRecord + 1
            destTable.Cells(findResult.Row, "K").Value = ICOUNT
        End If
        srcTable.Cells(iFor, "W").Value = SResult
    Next
    T2 = time()
    allWps = allWps - 2
    allEquipment = allEquipment - 2
    installationRate = allWps / (allEquipment - DuplicateRecord)
    installationRate = Round(installationRate * 100, 2)
    explainTxt = "设备的总记录数:" + Str(allEquipment) + "  比上一次检测:" + srcMemo
    explainTxt = explainTxt + vbCrLf + "WPS安装记录数:" + Str(allWps) + "  比上一次检测:" + destMemo
    explainTxt = explainTxt + vbCrLf + "重复记录数:" + Str(DuplicateRecord)
    explainTxt = explainTxt + vbCrLf + "WPS没安装数:" + Str(notInstalled)
    explainTxt = explainTxt + vbCrLf + "实际安装率:" + Str(installationRate) + "%"
    explainTxt = explainTxt + vbCrLf + " 运行耗时:" + Str(timeDiff(T2, T1)) + " 秒"
    MsgBox explainTxt, , "检查结果 11月1日 10:35"
End Sub
Function timeDiff(T2, T1)
    'T2,T1为时间
    '转换为秒
    Dim second2 As Long
    Dim second1 As Long
    second2 = Hour(T2) * 3600 + Minute(T2) * 60 + Second(T2)
    second1 = Hour(T1) * 3600 + Minute(T1) * 60 + Second(T1)
    timeDiff = Abs(second2 - second1)
End Function

Function contrastSheet(srcSheetName, destSheetName, contrastColName, signColName)
    '对比检查格式相同的两个表的数据变化
    'contrastColName:对比的列名
    'signColName:做标记的列名
    Dim iSrcRow, iDestRow As Integer             '源表和目标表的总行数
    Dim iFor As Integer
    Dim sTemp As String
    Dim findResult As Range                      '检查结果
    Dim lookUpColName As String                  '搜索的列名
    Dim findCount As Integer                     '找到的记录数
    
    T1 = time()
    Application.ScreenUpdating = False                                         '关闭屏幕更新
    Application.ActiveWindow.WindowState = xlMinimized                         '最小化
    lookUpColName = contrastColName + ":" + contrastColName
    
    Set srcSheet = Sheets(srcSheetName)                                        '源表sheet
    Set destSheet = Sheets(destSheetName)                                      '目标表sheet
    iSrcRow = srcSheet.Cells(Rows.Count, contrastColName).End(xlUp).Row        '源表的总行数
    iDestRow = destSheet.Cells(Rows.Count, contrastColName).End(xlUp).Row      '目标表的总行数
    For iFor = 3 To iSrcRow
        srcSheet.Cells(iFor, signColName).Value = "新增加"
    Next
    For iFor = 3 To iDestRow
        destSheet.Cells(iFor, signColName).Value = "消失"
    Next
    For iFor = 3 To iSrcRow
        sTemp = srcSheet.Cells(iFor, contrastColName).Value
        Set findResult = destSheet.Range(lookUpColName).Find(sTemp)
        'SResult = "没安装"
        If findResult Is Nothing Then
            '没有找到
            notInstalled = notInstalled + 1
        Else
            '找到
            findCount = findCount + 1
            srcSheet.Cells(iFor, signColName).Value = "★"                    '修改源表记录
            destSheet.Cells(findResult.Row, signColName).Value = "★"                   '修改目标表的记录
        End If
    Next
    T2 = time()
    Application.ScreenUpdating = False '开启屏幕更新
    Application.ActiveWindow.WindowState = xlMaximized     '最大化
    '有标题栏和头部,所以从第3行开始的,总记录数应该减去2
    contrastSheet = "新增记录:" + Str(iSrcRow - findCount - 2) + "  " + "消失记录:" + Str(iDestRow - findCount - 2)
End Function

  经过运行,可以在源表中找到新增加的记录,在目标表中找到消失的记录。

  显示结果:

 

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
©️2022 CSDN 皮肤主题:像素格子 设计师:CSDN官方博客 返回首页
评论

打赏作者

dawn

你的鼓励将是我创作的最大动力

¥2 ¥4 ¥6 ¥10 ¥20
输入1-500的整数
余额支付 (余额:-- )
扫码支付
扫码支付:¥2
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值