Sub dtxczjzmp()
Dim ar, arr(1 To 1000, 1 To 1)
i = Range("a65536").End(xlUp).Row
ar = Range("a1:a" & i)
For x = 1 To UBound(ar)
arr(ar(x, 1), 1) = ar(x, 1)
Next
Range("c1").Resize(UBound(arr)) = arr
End Sub
再重做:Sub aa9lee()
Dim arr, brr(1 To 1000), crr(1 To 1000, 1 To 1), i As Long
arr = Range("a1").CurrentRegion
For i = 1 To UBound(arr)
If IsEmpty(brr(arr(i, 1))) Then
brr(arr(i, 1)) = arr(i, 1)
x = x + 1
crr(x, 1) = arr(i, 1)
End If
Next
.Resize(x) = crr
End Sub
本帖最后由 EP学员 于 2011-12-21 03:23 编辑
交作业2
Sub EP学员()
Dim arr1(), arr2(1 To 1000), arr3()
Dim i As Integer, k As Integer
arr1 = Range(, Cells(.End(xlUp).Row, 1))
For i = 1 To UBound(arr1)
If arr2(arr1(i, 1)) = "" Then'不为空即为重复
arr2(arr1(i, 1)) = arr1(i, 1)
k = k + 1
ReDim Preserve arr3(1 To 1, 1 To k)
arr3(1, k) = arr1(i, 1)
End If
Next
Range("C1").Resize(k, 1) = Application.Transpose(arr3)
Stop
End Sub
Private Sub ldxhzy()
Dim Sou(), Tmp(1 To 1000), Tag()
Dim I As Long, J As Long
I = UsedRange.Rows.Count
J = 0
ReDim Sou(1 To I, 1 To 1)
Sou = Range(Cells(1, 1), Cells(I, 1))
For I = 1 To UsedRange.Rows.Count
If IsEmpty(Tmp(Sou(I, 1))) Then
J = J + 1
ReDim Preserve Tag(1 To 1, 1 To J)
Tmp(Sou(I, 1)) = Sou(I, 1)
Tag(1, J) = Sou(I, 1)
End If
Next I
I = UBound(Tag, 2)
Range(Cells(1, 3), Cells(I, 3)) = Application.Transpose(Tag)
End Sub
Sub 我不知道呀()
On Error Resume Next
Dim Only As New Collection
Dim arr, Arr2()
arr = Range(, .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
.Resize(j, 1) = WorksheetFunction.Transpose(Arr2)
End Sub
本帖最后由 wcymiss 于 2011-12-21 23:21 编辑
本道题思路比较狭窄，因为也是考知识点。
知识点：数组下标是唯一的。当字典的key值是整数时，可以用数组下标代替字典来处理数据。
这个可能平常用的不多，因为一遇到去重问题，直接想到的是字典了。这个其实和字典的基本原理很相近了，练习本题的目的，就是为下节字典课做准备，待学了字典后，大家可以比较一下数组去重和字典去重各自的优劣。
本题除了用数组下标去重，还可以用instr、fliter、like等文本处理函数（运算符）的方法来去重。但vba处理文本速度较慢。
好像想不出什么可写的了，以后想到什么再添加吧。:lol :lol
Benol 发表于 2011-12-17 19:25 static/image/common/back.gif
intArr(src(i, 1)) = 1
？
不会做的学习来了！{:091:}
Private Sub quchuchongfushuj()
On Error Resume Next
Dim a, b, c, r
Dim arr2, arr1(), arr3
r = Sheet1..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
4、18楼的方法非常巧妙啊。学习了。
每次循环中用fliter应该挺慢的，然后like比instr快很多。