[已解决]如何将A列数据不重复的填入到一个数组当中？并将这个数组重新填充到 B列

事后诸葛亮

如何将A列数据不重复的填入到一个数组当中？并将这个数组重新填充到 B列
假设有100个数据。
For i= 1 to 100
      arr临时(k)=cells(i,1)
      k=k+1
next i

差不多是这个模型吧。如果在填充之前进行判断，如果原有数组中有，则不填充。如果没有，则填充。

或者说 是字典吧？？
请用最简单的代码生成。谢谢。

最佳答案

月排行榜 / 总排行榜

adders

2013-6-22 00:36

If Range is not big (like you said, A1:A100), just use Collection:

1. Sub tt1()
   
2.     Range("B1:B100").ClearContents
   
3.     Dim Cel As Range, colMG As Collection, i As Byte
   
4.     Set colMG = New Collection
   
5.    
   
6.     On Error Resume Next
   
7.         For Each Cel In Range("A1:A100")
   
8.             colMG.Add Cel, CStr(Cel)
   
9.         Next Cel
   
10.     On Error GoTo 0
    
11.    
    
12.     For i = 1 To colMG.Count
    
13.         Range("B" & i) = colMG(i)
    
14.     Next i
    
15. End Sub

复制代码

With a huge Range in A column, for speed, you can combine array and collection:

1. Sub tt2()
   
2.     Range("B1:B" & Range("B1").End(xlDown).Row).ClearContents
   
3.     Dim a(), b(), colMG As Collection, i As Long, n As Long
   
4.     a = Range("A1:A" & Range("A1").End(xlDown).Row)
   
5.     Set colMG = New Collection
   
6.    
   
7.     On Error Resume Next
   
8.         For i = LBound(a) To UBound(a)
   
9.             colMG.Add a(i, 1), CStr(a(i, 1))
   
10.         Next i
    
11.     On Error GoTo 0
    
12.    
    
13.     n = colMG.Count
    
14.     ReDim b(1 To n)
    
15.     For i = 1 To n
    
16.         b(i) = colMG(i)
    
17.     Next i
    
18.    
    
19.     Range("B1").Resize(n, 1) = Application.Transpose(b)
    
20. End Sub
    

复制代码

Example file attached:

跳转到最佳答案楼层

suxiong

来附件！

lyf7276

arr临时(k)=cells(i,1)前面加上一句：if application.match(cells(i,1),arr,0)>0 then 跳过此句，不过这样没找到时会报错，还要做容错。用if application.counif(range("a1:a"&i-1,cells(i,1)>0来判断也行

adders

If Range is not big (like you said, A1:A100), just use Collection:

1. Sub tt1()
   
2.     Range("B1:B100").ClearContents
   
3.     Dim Cel As Range, colMG As Collection, i As Byte
   
4.     Set colMG = New Collection
   
5.    
   
6.     On Error Resume Next
   
7.         For Each Cel In Range("A1:A100")
   
8.             colMG.Add Cel, CStr(Cel)
   
9.         Next Cel
   
10.     On Error GoTo 0
    
11.    
    
12.     For i = 1 To colMG.Count
    
13.         Range("B" & i) = colMG(i)
    
14.     Next i
    
15. End Sub

复制代码

With a huge Range in A column, for speed, you can combine array and collection:

1. Sub tt2()
   
2.     Range("B1:B" & Range("B1").End(xlDown).Row).ClearContents
   
3.     Dim a(), b(), colMG As Collection, i As Long, n As Long
   
4.     a = Range("A1:A" & Range("A1").End(xlDown).Row)
   
5.     Set colMG = New Collection
   
6.    
   
7.     On Error Resume Next
   
8.         For i = LBound(a) To UBound(a)
   
9.             colMG.Add a(i, 1), CStr(a(i, 1))
   
10.         Next i
    
11.     On Error GoTo 0
    
12.    
    
13.     n = colMG.Count
    
14.     ReDim b(1 To n)
    
15.     For i = 1 To n
    
16.         b(i) = colMG(i)
    
17.     Next i
    
18.    
    
19.     Range("B1").Resize(n, 1) = Application.Transpose(b)
    
20. End Sub
    

复制代码

Example file attached: