[已解决]数据对比

fangniuji

A列数据源和B列数据源比较，A1和B1比，A2和B2比，A列和B列数据多的时候有十几万，如果有不一样，如A20和B20，A列和B列不一样 把它们提取C2以下，B列和A列不一样，把它们提取D2以下，同时提示比对有不一样，如果A，B列 数据都一样，提示比对结果一样

最佳答案

月排行榜 / 总排行榜

france723

2017-5-9 20:30

fangniuji 发表于 2017-5-9 20:05
1：如果B列多了B22到B28数据，在D列提取不出来，如果这个黄色区域数据在A列，C列是可以提取。
2：如果A ...

1. Sub aaa()
   
2. Dim arr, brr, i&, r&, y1, y2, y
   
3. y1 = Range("a1048576").End(3).Row
   
4. y2 = Range("b1048576").End(3).Row
   
5. If y1 > y2 Then
   
6.     y = y1
   
7. Else
   
8.     y = y2
   
9. End If
   
10. arr = Range("a1:b" & y)
    
11. ReDim brr(1 To UBound(arr), 1 To 2)
    
12. For i = 1 To UBound(arr)
    
13.   If arr(i, 1) <> arr(i, 2) Then
    
14.     r = r + 1
    
15.     brr(r, 1) = arr(i, 1)
    
16.     brr(r, 2) = arr(i, 2)
    
17.   End If
    
18. Next i
    
19. If r > 0 Then
    
20.   [c2].Resize(r, 2) = brr
    
21. 
    
22.   MsgBox "different"
    
23. Else
    
24.   MsgBox "same"
    
25. End If
    
26. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, r&
   
3. arr = Range("a1:b" & [a65536].End(3).Row)
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For i = 1 To UBound(arr)
   
6.   If arr(i, 1) <> arr(i, 2) Then
   
7.     r = r + 1
   
8.     brr(r, 1) = arr(i, 1)
   
9.     brr(r, 2) = arr(i, 2)
   
10.   End If
    
11. Next i
    
12. If r > 0 Then
    
13.   [c2].Resize(r, 2) = brr
    
14.   MsgBox "比对有不一样"
    
15. Else
    
16.   MsgBox "比对结果一样"
    
17. End If
    
18. End Sub

复制代码

fangniuji

大灰狼1976 发表于 2017-5-8 17:16

1：如果B列多了B22到B28数据，在D列提取不出来，如果这个黄色区域数据在A列，C列是可以提取。
2：如果A列和B列数据多余7万，会报错
这两个改一下，谢谢！！

france723

fangniuji 发表于 2017-5-9 20:05
1：如果B列多了B22到B28数据，在D列提取不出来，如果这个黄色区域数据在A列，C列是可以提取。
2：如果A ...

1. Sub aaa()
   
2. Dim arr, brr, i&, r&, y1, y2, y
   
3. y1 = Range("a1048576").End(3).Row
   
4. y2 = Range("b1048576").End(3).Row
   
5. If y1 > y2 Then
   
6.     y = y1
   
7. Else
   
8.     y = y2
   
9. End If
   
10. arr = Range("a1:b" & y)
    
11. ReDim brr(1 To UBound(arr), 1 To 2)
    
12. For i = 1 To UBound(arr)
    
13.   If arr(i, 1) <> arr(i, 2) Then
    
14.     r = r + 1
    
15.     brr(r, 1) = arr(i, 1)
    
16.     brr(r, 2) = arr(i, 2)
    
17.   End If
    
18. Next i
    
19. If r > 0 Then
    
20.   [c2].Resize(r, 2) = brr
    
21. 
    
22.   MsgBox "different"
    
23. Else
    
24.   MsgBox "same"
    
25. End If
    
26. End Sub

复制代码