excel数据透视表筛选,表格自动筛选重复数据
excel数据透视表筛选,表格自动筛选重复数据
dim crrr
arr = select '把选定区域赋值给arr变量,注册到内存
Set d = CreateObject("Scripting.Dictionary") '在内存注册第1个字典
Set d2 = CreateObject("Scripting.Dictionary") '在内存注册第2个字典
For i = 1 To UBound(arr) '在变量arr中遍历(走一遍)
For j = 1 To UBound(arr, 2)
sss = sss & arr(i, j)
Next
d(sss) = d(sss) + 1 '把arr变量每条数据并成一个字符串,写入第1个字典,并计算该数据出现的次数
If d(sss) = 2 Then k = k + 1: d2(sss) = k '如果次数大于1,把该字符串写入第2个字典,并按K变量给字典编序号
sss = ""
Next
ReDim crrr(1 To d2.Count, 1 To UBound(arr, 2) + 1) '重新注册crrr变量,准备存放重复数据及次数
k = 0
For i = 1 To UBound(arr) '在变量arr中再遍历(走一遍)
For j = 1 To UBound(arr, 2)
sss = sss & arr(i, j)
Next
If d(sss) > 1 Then '如果该字符串出现次数大于1,
For j = 1 To UBound(arr, 2)
crrr(d2(sss), j) = arr(i, j) '按第2个字典的序号把重复出现的数据给crrr变量赋值
Next
crrr(d2(sss), j) = d(sss) '按第2个字典的序号把重复出现次数给crrr变量赋值
End If
sss = ""
Next
For i = 1 To UBound(crrr, 2)
Columns(Target.Column + 1).Insert 'Target代表准备放置重复数据的区域比如range("k1"),在放置区域插入crrr变更同样大小的空列,以防止原有数据被覆盖
Next
Target.Resize(UBound(crrr), UBound(crrr, 2)) = crrr '放置重复数据及重复次数
Target.Resize(UBound(crrr), UBound(crrr, 2)).NumberFormatLocal = "G/通用格式" '把放置重复数据的区域单元格格式改为常规
excel