【字典与数组二期1班】第一讲作业数组去重（选做）【已开贴】

dtxczjzmp

1. Sub dtxczjzmp()
   
2.     Dim ar, arr(1 To 1000, 1 To 1)
   
3.     i = Range("a65536").End(xlUp).Row
   
4.     ar = Range("a1:a" & i)
   
5.     For x = 1 To UBound(ar)
   
6.         arr(ar(x, 1), 1) = ar(x, 1)
   
7.     Next
   
8.     Range("c1").Resize(UBound(arr)) = arr
   
9. End Sub

复制代码

9lee

再重做:

1. Sub aa9lee()
   
2. Dim arr, brr(1 To 1000), crr(1 To 1000, 1 To 1), i As Long
   
3. arr = Range("a1").CurrentRegion
   
4. For i = 1 To UBound(arr)
   
5.    If IsEmpty(brr(arr(i, 1))) Then
   
6.         brr(arr(i, 1)) = arr(i, 1)
   
7.         x = x + 1
   
8.         crr(x, 1) = arr(i, 1)
   
9.    End If
   
10. Next
    
11. [d1].Resize(x) = crr
    
12. End Sub

复制代码

EP学员

交作业2

1. 
   
2. Sub EP学员()
   
3.     Dim arr1(), arr2(1 To 1000), arr3()
   
4.     Dim i As Integer, k As Integer
   
5.     arr1 = Range([A1], Cells([A65536].End(xlUp).Row, 1))
   
6.     For i = 1 To UBound(arr1)
   
7.         If arr2(arr1(i, 1)) = "" Then'不为空即为重复
   
8.             arr2(arr1(i, 1)) = arr1(i, 1)
   
9.             k = k + 1
   
10.             ReDim Preserve arr3(1 To 1, 1 To k)
    
11.             arr3(1, k) = arr1(i, 1)
    
12.         End If
    
13.     Next
    
14.     Range("C1").Resize(k, 1) = Application.Transpose(arr3)
    
15.     Stop
    
16. End Sub

复制代码

ldxhzy

1. Private Sub ldxhzy()
   
2.     Dim Sou(), Tmp(1 To 1000), Tag()
   
3.     Dim I As Long, J As Long
   
4.     I = UsedRange.Rows.Count
   
5.     J = 0
   
6.     ReDim Sou(1 To I, 1 To 1)
   
7.     Sou = Range(Cells(1, 1), Cells(I, 1))
   
8.     For I = 1 To UsedRange.Rows.Count
   
9.         If IsEmpty(Tmp(Sou(I, 1))) Then
   
10.             J = J + 1
    
11.             ReDim Preserve Tag(1 To 1, 1 To J)
    
12.             Tmp(Sou(I, 1)) = Sou(I, 1)
    
13.             Tag(1, J) = Sou(I, 1)
    
14.         End If
    
15.     Next I
    
16.     I = UBound(Tag, 2)
    
17.     Range(Cells(1, 3), Cells(I, 3)) = Application.Transpose(Tag)
    
18. End Sub

复制代码

我不知道呀

Sub 我不知道呀()
    On Error Resume Next
    Dim Only As New Collection
    Dim arr, Arr2()
    arr = Range([a1], [a65536].End(xlUp)).Value
    For i = 1 To UBound(arr) Step 1
        Only.Add arr(i, 1), CStr(arr(i, 1))
        If Err = 0 Then
            j = j + 1
            ReDim Preserve Arr2(1 To 1, 1 To j)
            Arr2(1, j) = Only(j)
        End If
        Err.Clear
    Next
    [b1].Resize(j, 1) = WorksheetFunction.Transpose(Arr2)
   
End Sub

wcymiss

        本道题思路比较狭窄，因为也是考知识点。
        知识点：数组下标是唯一的。当字典的key值是整数时，可以用数组下标代替字典来处理数据。
        这个可能平常用的不多，因为一遇到去重问题，直接想到的是字典了。这个其实和字典的基本原理很相近了，练习本题的目的，就是为下节字典课做准备，待学了字典后，大家可以比较一下数组去重和字典去重各自的优劣。
        
        本题除了用数组下标去重，还可以用instr、fliter、like等文本处理函数（运算符）的方法来去重。但vba处理文本速度较慢。
        好像想不出什么可写的了，以后想到什么再添加吧。

ls

Benol 发表于 2011-12-17 19:25

  intArr(src(i, 1)) = 1


？

徐淑颖

不会做的学习来了！{:091:}

jiangslly

Private Sub quchuchongfushuj()
On Error Resume Next
  Dim a, b, c, r
    Dim arr2, arr1(), arr3
   r = Sheet1.[a65536].End(xlUp).Row
    Dim cen As New Collection
    arr2 = Sheet1.Range("a1:a" & r)
  arr3 = Application.WorksheetFunction.Transpose(arr2)
   For a = 1 To UBound(arr3)
     cen.Add arr3(a), CStr(arr3(a))
   Next
  For a = 1 To cen.Count
      ReDim Preserve arr1(1 To a)
     arr1(a) = cen(a)
   Next a
  Range("b1:b" & UBound(arr1)) = Application.WorksheetFunction.Transpose(arr1())
End Sub

wjc2090742

4、18楼的方法非常巧妙啊。学习了。

每次循环中用fliter应该挺慢的，然后like比instr快很多。