[已解决]急，在线等，下面这个代码运行返回的值有重复的。

v-cand

图一为我想要得到的结果，   图二为运行代码时的图片，    不知道是哪里出错 了，帮忙看看，前提是在原代码中修改，因为源代码中可以对查找区域和返回值的位置随意选择

最佳答案

月排行榜 / 总排行榜

grf1973

2015-7-22 11:12

完全用原代码

1. Sub 不重复()
   
2.      Dim rg1 As Range, rg2 As Range
   
3.      Dim D, RG As Range
   
4.      Dim x$
   
5.      Set rg1 = Application.InputBox("请选择数据源区域。本次操作将会筛选出数据区的不重复项，存于另指定位置。", "如有疑问，请联系作者", "$A$1:$B$4", , , , , 8)
   
6.      Set D = CreateObject("scripting.dictionary")  '-----------字典的应用语句
   
7.     Set rg2 = Application.InputBox("请选择结果存放区域。", "如有疑问，请联系作者", "$D$1", , , , , 8)
   
8.      ReDim arr(1 To 1, 1 To rg1.Count * 2)
   
9.      N = 1
   
10.      For Each RG In rg1
    
11.         x = Trim(RG.Value)
    
12.          If D.exists(x) Or x = "" Then   '判断数组元素arr1(x,1)在字典关键词里是否存在,
    
13.          Else '如果关键词arr1(x,1)不存在,那么
    
14.               arr(1, N) = x
    
15.                D(x) = N
    
16.                N = N + 2
    
17.           End If
    
18.      Next RG
    
19.      rg2.Cells(1, 1).Resize(1, N - 2) = arr
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

爱疯

对于数据源A1:B928，不知希望怎样处理，需求是啥？

grf1973

代码没错，数据源中有前后有空格，用trim去掉即可。

1. Sub 不重复()
   
2.      Dim rg1 As Range, rg2 As Range
   
3.      Dim D, RG As Range
   
4.      Dim x$
   
5.      Set rg1 = Application.InputBox("请选择数据源区域。本次操作将会筛选出数据区的不重复项，存于另指定位置。", "如有疑问，请联系作者", "$A$1:$B$4", , , , , 8)
   
6.      Set D = CreateObject("scripting.dictionary")  '-----------字典的应用语句
   
7.      Set rg2 = Application.InputBox("请选择结果存放区域。", "如有疑问，请联系作者", "$D$1", , , , , 8)
   
8.      ReDim arr(1 To 1, 1 To rg1.Count * 2)
   
9.      N = 1
   
10.      For Each RG In rg1
    
11.         x = Trim(RG.Value)
    
12.         If x <> "" Then
    
13.             If Not D.exists(x) Then    '判断数组元素arr1(x,1)在字典关键词里是否存在,'如果关键词arr1(x,1)不存在,那么
    
14.               arr(1, N) = x
    
15.                D(x) = N
    
16.                N = N + 2
    
17.             End If
    
18.         End If
    
19.      Next RG
    
20.      rg2.Cells(1, 1).Resize(1, N - 2) = arr
    
21. End Sub
    

复制代码

grf1973

完全用原代码

1. Sub 不重复()
   
2.      Dim rg1 As Range, rg2 As Range
   
3.      Dim D, RG As Range
   
4.      Dim x$
   
5.      Set rg1 = Application.InputBox("请选择数据源区域。本次操作将会筛选出数据区的不重复项，存于另指定位置。", "如有疑问，请联系作者", "$A$1:$B$4", , , , , 8)
   
6.      Set D = CreateObject("scripting.dictionary")  '-----------字典的应用语句
   
7.     Set rg2 = Application.InputBox("请选择结果存放区域。", "如有疑问，请联系作者", "$D$1", , , , , 8)
   
8.      ReDim arr(1 To 1, 1 To rg1.Count * 2)
   
9.      N = 1
   
10.      For Each RG In rg1
    
11.         x = Trim(RG.Value)
    
12.          If D.exists(x) Or x = "" Then   '判断数组元素arr1(x,1)在字典关键词里是否存在,
    
13.          Else '如果关键词arr1(x,1)不存在,那么
    
14.               arr(1, N) = x
    
15.                D(x) = N
    
16.                N = N + 2
    
17.           End If
    
18.      Next RG
    
19.      rg2.Cells(1, 1).Resize(1, N - 2) = arr
    
20. End Sub
    

复制代码

v-cand

爱疯 发表于 2015-7-22 11:06
对于数据源A1:B928，不知希望怎样处理，需求是啥？

就是查找A1:B928区域中有哪些是不相同的值，