急急急急！！！！需要用EXCEL VBA编程实现表格查找核查功能，急需使用，望大神帮忙

zhangru2199

希望有会的大神帮忙，最近工作急需实现，有些难度，非常感谢

chaohuahch

以下代码，供测试：

1. Sub fyExcelVba()
   
2. Dim arr, brr, crr(), i%, j%
   
3. Dim dic As Object
   
4. arr = Sheets("电费台账").Range("a1").CurrentRegion
   
5. brr = Sheets("报账数据").Range("a1").CurrentRegion
   
6. ReDim crr(1 To UBound(arr) + 1, 1 To UBound(arr, 2))
   
7. Set dic = CreateObject("scripting.dictionary")
   
8. mm = 1
   
9. For i = 2 To UBound(arr)
   
10.     arr(i, 14) = DateValue(arr(i, 14))
    
11.     arr(i, 15) = DateValue(arr(i, 15))
    
12.     arr(i, 22) = CDbl(arr(i, 22))
    
13.     k = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 14) & arr(i, 15) & arr(i, 29) _
    
14.         & arr(i, 30) & arr(i, 32) & arr(i, 31) & arr(i, 21) & arr(i, 22) & arr(i, 23) & arr(i, 33)
    
15.     brr(i, 12) = Round(brr(i, 12) / 1.16, 2)
    
16.     brr(i, 13) = Round(brr(i, 13), 2)
    
17.     kk = brr(i, 2) & brr(i, 3) & brr(i, 4) & brr(i, 6) & brr(i, 7) & brr(i, 8) _
    
18.         & brr(i, 9) & brr(i, 11) & brr(i, 12) & brr(i, 13) & brr(i, 14) & brr(i, 15) & brr(i, 20)
    
19.      dic(kk) = ""
    
20.      If Not dic.exists(k) Then
    
21.        mm = mm + 1
    
22.       For n = 1 To UBound(arr, 2)
    
23.         crr(mm, n) = arr(i, n)
    
24.      Next n
    
25.     End If
    
26. Next i
    
27. 
    
28. For n = 1 To UBound(arr, 2)
    
29. crr(1, n) = arr(1, n)
    
30. Next n
    
31. 
    
32. With Sheets("报账与台账核实")
    
33. .Cells.ClearContents
    
34. .Range("a1").Resize(UBound(crr), UBound(crr, 2)) = crr
    
35. End With
    
36. End Sub
    
37. 
    

复制代码

chaohuahch

chaohuahch 发表于 2018-8-9 22:07
以下代码，供测试：

结果有12行数据（去掉标题行）有11行数据，是电损耗不同。最后已给数据的不同，未查找出来

chaohuahch

chaohuahch 发表于 2018-8-9 22:44
结果有12行数据（去掉标题行）有11行数据，是点损号不同。最后已给数据的不同，未查找出来

两个表格  枣庄市峄城区坛山办事处岳庄老社区  这一串字符不一致。请自查一下。

zhangru2199

您好提取出来出现问题的数据没有标红