数组与字典解决方案第二十八讲 从两列数据中提取重复数据并排重处理
《VBA数组与字典方案》教程（10144533）是我推出的第三套教程，目前已经是第二版修订了。这套教程定位于中级，字典是VBA的精华，我要求学员必学。7.1.3.9教程和手册掌握后，可以解决大多数工作中遇到的实际问题。
这套字典教程共两册，一共八十四讲，今后一段时间会给大家陆续推出修订后的教程内容。今日的内容是：数组与字典解决方案第二十八讲 从两列数据中提取重复数据并排重处理
【分享成果，随喜正能量】绳锯木断，水滴石穿。也许你现在做的事情很小，只要你能日积月累的坚持下去，才会发现意义非凡。所谓的成功，便是别人失败的时候你还在坚持。
第二十八讲 从两列数据中提取重复数据并排重处理
大家好，今日我们继续VBA数组与字典解决方案数组相关知识的讲解，今日我们讲解的是第28讲：如何从两列的数据中提出重复的数据并且做排重处理。这讲的内容和上一讲一样，主要是数组理论的学习，让大家认清什么是数组，什么是动态数组，进而认识数组和工作表结合的的一些操作。
1 代码应用的场景要求及实现的思路分析
如下面截图的内容：
两列数据中有很多重复的数据，我们要提取出重复的数据，然后排重处理。我们先看看解决这个问题的思路：
1） 把两列数据导入数组
2） 把得到的两个数组分别变成一维的数组
3） 在数组1中查询数组2的重复值，计入数组3中
4） 在数组2中查找数组1中的重复值计入数组3中
5) 对数组3进行排重处理。
2 实现应用场景的代码及分析
看代码：
Sub MyNZsz_28() '第28讲 两列数中数组重复的值提取
Sheets("28").Select
Dim temvarArr1(), temvarArr2(), tem(), sparr(), arr()
varArr1 = Range("A1:A" & Range("A1").End(xlDown).Row) '将A列数据写入数组
varArr2 = Range("B1:B" & Range("B1").End(xlDown).Row) '将B列数据写入数组
ReDim temvarArr1(1 To UBound(varArr1)) '将A列数据写入动态一维数组
For i = 1 To UBound(varArr1)
temvarArr1(i) = varArr1(i, 1)
Next
ReDim temvarArr2(1 To UBound(varArr2)) '将B列数据写入动态一维数组
For i = 1 To UBound(varArr2)
temvarArr2(i) = varArr2(i, 1)
Next
r = -1
For i = 1 To UBound(temvarArr2)
Temp = Filter(temvarArr1, temvarArr2(i), True)
If UBound(Temp) >= 0 Then
r = r + 1
ReDim Preserve arr(r)
arr(r) = temvarArr2(i)
End If
Next
For i = 1 To UBound(temvarArr1)
r = r + 1
ReDim Preserve arr(r)
arr(r) = temvarArr1(i)
End If
Next
[c:e].ClearContents
Range("C1") = "两列数中重复值"
[c2].Resize(UBound(arr) + 1) = WorksheetFunction.Transpose(arr)
ReDim sparr(0)
sparr(0) = arr(0)
For i = 1 To r
Temp = Filter(sparr, arr(i), True)
If UBound(Temp) < 0 Then
t = t + 1
ReDim Preserve sparr(t)
sparr(t) = arr(i)
End If
Next
Range("d1") = "排重"
[d2].Resize(t + 1) = WorksheetFunction.Transpose(sparr)
End Sub
代码截图：
代码讲解：
1） r = -1
For i = 1 To UBound(temvarArr2)
Temp = Filter(temvarArr1, temvarArr2(i), True)
If UBound(Temp) >= 0 Then
r = r + 1
ReDim Preserve arr(r)
arr(r) = temvarArr2(i)
End If
Next
For i = 1 To UBound(temvarArr1)
Temp = Filter(temvarArr2, temvarArr1(i), True)
If UBound(Temp) >= 0 Then
r = r + 1
ReDim Preserve arr(r)
arr(r) = temvarArr1(i)
End If
Next
上述代码的过程实现了在两个数组中分别查找重复的值并计入一个新的数组。
2） ReDim sparr(0)
sparr(0) = arr(0)
For i = 1 To r
Temp = Filter(sparr, arr(i), True)
If UBound(Temp) < 0 Then
t = t + 1
ReDim Preserve sparr(t)
sparr(t) = arr(i)
End If
Next
上述代码的过程执行后把新的数组进行了排重。
特别注意点：
a 关于利用数组排重，我最近的代码，可以作为一个固定的模式来记住。
b 关于查找相同值的问题利用Filter 函数的意义不是很大，因为这个是模糊查找，往往不是我们所需要的，所以在利用的时候要注意分清利用的范围。
c 数组的建立和转换要留意我的代码。
下面看代码的运行结果：
今日内容回向：
1 关于数组的Filter 函数 是否理解了呢？
2 如果在上述的数据中，如A列的数据增加一个1，会在第三列出现吗？会在第四列出现吗？
我多年的VBA实践经验，全部浓缩在以下教程中：