请教各位老师，如何用VBA找出两列中不同的值？

zhaogang1960

莫悠悠 发表于 2014-5-19 18:13
表1的名字可能与表2的名字不一致，如何找到不一致的名单，并标出来源。
表1的名字是掌握在报账部门的基础 ...

1. Sub Macro1()
   
2.     Dim d(1 To 2) As Object, arr, i&, j&
   
3.     For j = 1 To 2
   
4.         Set d(j) = CreateObject("scripting.dictionary")
   
5.         arr = Sheets(j).[a1].CurrentRegion
   
6.         For i = 2 To UBound(arr)
   
7.             d(j)(arr(i, 1)) = ""
   
8.         Next
   
9.     Next
   
10.     For i = 2 To UBound(arr)
    
11.         If d(1).Exists(arr(i, 1)) And d(2).Exists(arr(i, 1)) Then
    
12.             d(1).Remove (arr(i, 1))
    
13.             d(2).Remove (arr(i, 1))
    
14.         End If
    
15.     Next
    
16.     For i = 1 To 2
    
17.         With Sheets(i + 2)
    
18.             .Cells.ClearContents
    
19.             .[a1].Resize(d(i).Count) = WorksheetFunction.Transpose(d(i).Keys)
    
20.         End With
    
21.     Next
    
22. End Sub

复制代码

zhaogang1960

请看附件
不同值的求助.rar (10.68 KB, 下载次数: 316)

2014-5-19 18:33 上传

点击文件名下载附件

frdes

zhaogang1960 发表于 2011-2-26 14:38
Sub Macro1()
    Dim arr, brr(), d As Object, i&
    Set d = CreateObject("scripting.dictionary" ...

ReDim brr(1 To UBound(arr), 0)和brr(i,0) =arr(i,1)这个0是什么意思？

zhaogang1960

ReDim brr(1 To UBound(arr), 0)定义一个多行、只有一列的二维数组，完整写法：ReDim brr(1 To UBound(arr), 0 to 0)，因为通常0为默认最小下标，这里就省略了
brr(i,0) =arr(i,1)——给brr第i行、第1列赋值

莫悠悠

zhaogang1960 发表于 2014-5-19 18:33

非常感谢超级版主赵大哥的帮忙，得研究一下怎样用到工作中

frdes

zhaogang1960 发表于 2014-5-19 22:20
ReDim brr(1 To UBound(arr), 0)定义一个多行、只有一列的二维数组，完整写法：ReDim brr(1 To UBound(arr) ...

这个0写成1 To 1行不行？

莫悠悠

zhaogang1960 发表于 2014-5-19 18:33

赵大哥，再次请教：如果两个表之间没有规律，那应该如何改造脚本？
For j = 1 To 2

04.        Set d(j) = CreateObject("scripting.dictionary")

05.        arr = Sheets(j).[a1].CurrentRegion

06.        For i = 2 To UBound(arr)

07.            d(j)(arr(i, 1)) = ""

08.        Next

09.    Next
我把这个循环拆分为两个记录实现不了我的目的
表1、表2不一定是sheet1和sheet2，很多时候都有可能是sheet1和sheet6，或者是其他情况……
arr = Sheets(j).[a1].CurrentRegion，很多都是任意组合的

panliang9

需要用到这个，必须标记一下！

featherain

将下面代码插入到相应表单的VBE窗口中。

1. Sub GetUniqueItem()
   
2. 
   
3.     Dim tmpRange As Range
   
4.    
   
5.     Set tmpRange = Cells.SpecialCells(xlCellTypeLastCell)
   
6.     Set tmpRange = Range("D1:D" & tmpRange.Row)
   
7.     tmpRange.FormulaR1C1 = "=IF(AND(RC1&RC2<>"""",COUNTIF(C2,RC1)=0),""#DIV/0!"","""")"
   
8.     tmpRange.Value = tmpRange.Value
   
9.     Set tmpRange = Cells.SpecialCells(xlCellTypeConstants, 16)
   
10.     Set tmpRange = tmpRange.Offset(0, 1 - tmpRange.Column)
    
11.     Range("C:C").Clear
    
12.     tmpRange.Copy Range("C1")
    
13.    
    
14.     Set tmpRange = Cells.SpecialCells(xlCellTypeLastCell)
    
15.     Set tmpRange = Range("D1:D" & tmpRange.Row)
    
16.     tmpRange.EntireColumn.Delete
    
17.    
    
18.     Set tmpRange = Nothing
    
19. End Sub

复制代码

约定的童话

zhaogang1960 发表于 2014-5-19 18:34
请看附件

大神，最后的结果能不能一弹窗形式体现，不用填到表格里面，要怎么改？