[已解决]求按行筛选重复的代码

sanfuhai · 发表于 2017-4-21 12:34

求筛选重复和不重复的代码.rar (4.46 KB, 下载次数: 10)

Excel学徒123 · 发表于 2017-4-21 13:41

将重复的和不重复的筛选到Y列，这是什么鬼

sanfuhai · 发表于 2017-4-21 13:44

Excel学徒123 发表于 2017-4-21 13:41
将重复的和不重复的筛选到Y列，这是什么鬼

版主大神，是按行筛选的，筛选到对应的同行的Y列，就是筛选到Y2,Y3....等

grf1973 · 发表于 2017-4-21 14:57

Sub tt()
arr = [b2:L50]
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If Len(arr(i, j)) Then d(arr(i, j)) = ""
Next
If d.Count > 0 Then Cells(i + 1, "Y").Resize(1, d.Count) = d.keys
d.RemoveAll
Next
End Sub

复制代码

pengyx · 发表于 2017-4-21 15:09

sub pengyx()
ar=range("b2:l50")
redim br(1 to ubound(ar),1 to 1)
for i=1 to ubound(ar)
redim cr(application.max(range(cells(i+1,2),cells(i+1,"l"))))
for j=1 to ubound(ar,2)
if ar(i,j)<>"" then
if cr(ar(i,j))="" then
cr(ar(i,j))=ar(i,j)
br(i,1)=br(i,1)&cr(ar(i,j))
end if
end if
next
next
range("y2").resize(ubound(ar),1)=br
end sub
没有测试哈，试试

大灰狼1976 · 发表于 2017-4-21 17:48

这个最佳答案由大灰狼1976 给出，感谢大灰狼1976 的回答。

单击隐藏图章

Sub aaa()
Dim arr, brr, i&, j&, c&, d As Object
arr = [b2:l50]
Set d = CreateObject("scripting.dictionary")
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If arr(i, j) <> "" Then
If Not d.exists(arr(i, j)) Then
c = c + 1
d(arr(i, j)) = ""
brr(i, c) = arr(i, j)
End If
End If
Next j
c = 0
d.RemoveAll
Next i
[y2].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

复制代码

		自动登录	找回密码
密码			注册

[已解决]求按行筛选重复的代码

评分

评分

评分