求助多列数据与多张表格同一列数据对比找出错误

dagal

每月各部门上交的报表中有本月数与上年同期数对比，但总是有人粗心，上交的报表中上年同期数这一列会出错，导致在汇总数据时只能人工一张张报表与去年的报表进行对减找出错的单元格。现上传已做好的去年各部门上年同期数的汇总表，每一列为一个部门，均用代码体现。需要实现的是与各文件夹下B表工作簿（如1806-JZ03B表.xls）中“汇总”表的E列进行比对，将有错误的单元格在汇总表各部门的列中用颜色标出

opiona

有点费工付

1. 
   
2.     Set SHX = Worksheets("汇总")
   
3.     SHX.Range("A5:HZ65536").Interior.ColorIndex = xlNone         '取消单元填充色
   
4.    
   
5.         Rem 文件清单
   
6.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False) '//含子文件夹；文件路径
   
7.     For ICOL = 3 To SHX.Range("IU4").End(xlToLeft).Column
   
8.    
   
9.         Rem  提示信息，在状态栏显示
   
10.         Application.StatusBar = "当前公司名是：" & SHX.Cells(4, ICOL).Value
    
11.         DoEvents
    
12.         
    
13.         Rem 每一列是一个文件，含：B
    
14.         For I = 0 To UBound(FileArr)
    
15.             Filename = GetPathFromFileName(FileArr(I), False)
    
16.             If InStr(Filename, "-" & SHX.Cells(4, ICOL).Value & "B") > 0 Then
    
17.             
    
18.                 Rem  提示信息，在状态栏显示
    
19.                 Application.StatusBar = "当前公司名是：" & SHX.Cells(4, ICOL).Value & "    对应工作簿是：" & Filename
    
20.                 DoEvents
    
21.                
    
22.                 Set WB = Workbooks.Open(FileArr(I))
    
23.                 For Each SHW In WB.Worksheets
    
24.                     If SHW.Name = "汇总" Then
    
25.                         Rem 假设每个表 都在：E列，而且每行和汇总表的相同
    
26.                         For IROW = 5 To SHX.Range("A65536").End(3).Row
    
27.                             If IsNumeric(SHX.Cells(IROW, ICOL).Value) = True And IsNumeric(SHW.Cells(IROW, 5).Value) = True Then
    
28.                                 If SHX.Cells(IROW, ICOL).Value <> SHW.Cells(IROW, 5).Value Then
    
29.                                     Rem 标注为：黄色，红色背景
    
30.                                     SHX.Cells(IROW, ICOL).Interior.Color = 255 '//65535
    
31.                                 End If
    
32.                             End If
    
33.                         Next
    
34.                     End If
    
35.                 Next
    
36.                 WB.Close False
    
37.                 Set WB = Nothing
    
38.                
    
39.             End If
    
40.         Next
    
41.     Next

复制代码

opiona

QQ14885553.rar (1.51 MB, 下载次数: 27)

2018-7-14 17:55 上传

点击文件名下载附件

细节自己调整吧

dagal

opiona 发表于 2018-7-14 17:55
细节自己调整吧

经测试，大部分数据是对的，但部分列与文件夹的原数据对比是一致的，但也显示了红色，不知是何原因？特别是从JZ06-JZG2这几列，均与原文件汇总表中数据比对过了，烦请帮忙再看看，谢谢！

dagal

经过2楼师傅提点，在代码if SHX.Cells(IROW, ICOL).Value <> SHW.Cells(IROW, 5).Value then这一句中加入round函数if Round(SHX.Cells(IROW, ICOL).Value, 2) <> Round(SHW.Cells(IROW, 5).Value, 2)  then后解决了以上问题。 谢谢~~好人一生平安！