excelvba提取一行不重复数据?dim crrrarr = select '把选定区域赋值给arr变量,注册到内存，今天小编就来说说关于excelvba提取一行不重复数据?下面更多详细答案一起来看看吧!

excelvba提取一行不重复数据

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)).NumberFormatLocal = "@" '把放置重复数据的区域单元格格式改为文本类型,防止超15位的数字显示出问题

Target.Resize(UBound(crrr), UBound(crrr, 2)) = crrr '放置重复数据及重复次数

Target.Resize(UBound(crrr), UBound(crrr, 2)).NumberFormatLocal = "G/通用格式" '把放置重复数据的区域单元格格式改为常规

,