数值与字典解决方案第二十八讲：从两列数据中提取重复数据排重

《VBA数组与字典方案》教程（10144533）是我推出的第三套教程，目前已经是第二版修订了。这套教程定位于中级，字典是VBA的精华，我要求学员必学。7.1.3.9教程和手册掌握后，可以解决大多数工作中遇到的实际问题。

这套字典教程共两册，一共八十四讲，今后一段时间会给大家陆续推出修订后的教程内容。今日的内容是：数值与字典解决方案第二十八讲：从两列数据中提取重复数据并排重处理

【分享成果，随喜正能量】191 得失，可以说是人类事业上的考验，不要因一时的得失影响一生的期许。得失是一时的，理想是一生的。一旦被欲望的毒箭射中，心会变得麻木，失去觉知，甚至疯狂。如果没有及时清醒，就会如同爱美的飞蛾扑向火焰、贪吃的鱼儿被鱼钩钓起，当发现自己身处险境时，后悔也来不及了。。

第二十八讲 从两列数据中提取重复数据并排重处理

大家好，今日我们继续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)

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

《待续》

我多年的VBA实践经验，全部浓缩在以下教程中：