《VBA数组与字典方案》教程（10144533）是我推出的第三套教程，目前已经是第二版修订了。这套教程定位于中级，字典是VBA的精华，我要求学员必学。7.1.3.9教程和手册掌握后，可以解决大多数工作中遇到的实际问题。
这套字典教程共两册，一共八十四讲，今后一段时间会给大家陆续推出修订后的教程内容。今日的内容是：数值与字典解决方案第二十八讲：两列数据排重处理的实现应用场景的代码及分析
【分享成果，随喜正能量】221单单修慧而不修福，又会得到什么结果呢？“修慧不修福，罗汉托空钵”，尽是学习经典，不去付诸行动，也是不行。做善事就是“诸恶莫作，众善奉行”，因为在因地不修福，在果地就没有福。
第二十八讲 从两列数据中提取重复数据并排重处理
大家好，今日我们继续VBA数组与字典解决方案数组相关知识的讲解，今日我们讲解的是第28讲：如何从两列的数据中提出重复的数据并且做排重处理。这讲的内容和上一讲一样，主要是数组理论的学习，让大家认清什么是数组，什么是动态数组，进而认识数组和工作表结合的的一些操作。
实现应用场景的代码及分析
看代码：
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)
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
[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实践经验，全部浓缩在以下教程中：