[已解决]如何做一个宏： 通过比较A列与B列的内容是否相同

bipl607

如何做一个宏：
通过比较A列与B列的内容是否相同，并把B列中，与A列不同的内容放入C列。谢谢！

最佳答案

月排行榜 / 总排行榜

独奏

2014-3-9 22:48

1. Sub test()
   
2. Dim d,  arr, brr, crr()
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1:a" & [a65536].End(xlUp).Row)
   
5. brr = Range("b1:b" & [a65536].End(xlUp).Row)
   
6. For r = LBound(arr) To UBound(arr)
   
7.     d(arr(r, 1)) = ""
   
8. Next
   
9. For r = LBound(brr) To UBound(brr)
   
10.     If Not d.exists(brr(r, 1)) Then
    
11.         i = i + 1
    
12.         ReDim Preserve crr(1 To i)
    
13.         crr(i) = brr(r, 1)
    
14.     End If
    
15. Next
    
16. Range("c1").Resize(i) = Application.Transpose(crr)
    
17. Set arr = Nothing
    
18. Set brr = Nothing
    
19. Erase crr
    
20. End Sub

复制代码

跳转到最佳答案楼层

独奏

1. Sub test()
   
2. Dim d,  arr, brr, crr()
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1:a" & [a65536].End(xlUp).Row)
   
5. brr = Range("b1:b" & [a65536].End(xlUp).Row)
   
6. For r = LBound(arr) To UBound(arr)
   
7.     d(arr(r, 1)) = ""
   
8. Next
   
9. For r = LBound(brr) To UBound(brr)
   
10.     If Not d.exists(brr(r, 1)) Then
    
11.         i = i + 1
    
12.         ReDim Preserve crr(1 To i)
    
13.         crr(i) = brr(r, 1)
    
14.     End If
    
15. Next
    
16. Range("c1").Resize(i) = Application.Transpose(crr)
    
17. Set arr = Nothing
    
18. Set brr = Nothing
    
19. Erase crr
    
20. End Sub

复制代码

as0810114

C1数组公式，下拉

1. =INDEX(B$1:B$48,SMALL(IF(COUNTIF(A$1:A$134,B$1:B$47),48,ROW($1:$47)),ROW()))&""

复制代码

pengyx

A列有重复值吗？比如：A列是否存在多个“caonz”，B列是否有多个“alslcx_6501”？

bipl607

多个时保留一个，谢谢！

bipl607

独奏 发表于 2014-3-9 22:48

到Stop时不能运行？怎么改革谢谢！

风林火山

1. Sub B有A无()
   
2.     Dim arr, brr(), k%, i%, n%, d '定义变量
   
3.     arr = Range("a1:b" & Cells(Rows.Count, 1).End(3).Row) '定义数据源
   
4.     Set d = CreateObject("scripting.dictionary") '创建字典
   
5.     '把A列数据装入字典
   
6.     For k = 1 To UBound(arr)
   
7.         If Not d.exists(arr(k, 1)) Then d(arr(k, 1)) = ""
   
8.     Next
   
9.     '判断B列数据在A列是否存在，不存在，装入brr数组
   
10.     For i = 1 To UBound(arr)
    
11.         If arr(i, 2) <> "" Then
    
12.             If Not d.exists(arr(i, 2)) Then '判断B列数据在A列是否存在
    
13.                 n = n + 1
    
14.                 ReDim Preserve brr(1 To n) '重新定义数组
    
15.                 brr(n) = arr(i, 2) 'B列有A列没有的数据添加到brr数组中
    
16.             End If
    
17.         End If
    
18.     Next i
    
19.     '在C列显示B列有A列没有的数据
    
20.     Range("c1").Resize(n, 1) = Application.WorksheetFunction.Transpose(brr)
    
21. End Sub
    

复制代码

独奏

删掉stop 就好，我记了删除

bipl607

多谢各位高手，独奏的代码比风林火山早，但风林火山的代码有解释，最后抽签，独奏胜出，谢谢风林火山