[已解决]用VBA数组 双重循环去A列重复 结果保存D列

laoau138

用VBA数组   双重循环去A列重复   结果保存D列

不要用字典方法  只用数组方法


按钮控制结果输出

最佳答案

月排行榜 / 总排行榜

望帝春心

2017-3-1 19:56

1. Sub test()
   
2.     Dim arr, brr
   
3.     arr = Cells(1, 1).CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         For j = 1 To i - 1
   
6.             If arr(i, 1) = arr(j, 1) Then
   
7.                 n = n + 1
   
8.             End If
   
9.         Next
   
10.         If n > 0 Then
    
11.             arr(i, 1) = "@"
    
12.         End If
    
13.         n = 0
    
14.     Next
    
15.     brr = VBA.Filter(Application.Transpose(arr), "@", False)
    
16.     [d1].Resize(UBound(brr) + 1, 1) = Application.Transpose(brr)
    
17. End Sub

复制代码

跳转到最佳答案楼层

望帝春心

1. Sub test()
   
2.     Dim arr, brr
   
3.     arr = Cells(1, 1).CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         For j = 1 To i - 1
   
6.             If arr(i, 1) = arr(j, 1) Then
   
7.                 n = n + 1
   
8.             End If
   
9.         Next
   
10.         If n > 0 Then
    
11.             arr(i, 1) = "@"
    
12.         End If
    
13.         n = 0
    
14.     Next
    
15.     brr = VBA.Filter(Application.Transpose(arr), "@", False)
    
16.     [d1].Resize(UBound(brr) + 1, 1) = Application.Transpose(brr)
    
17. End Sub

复制代码

ilovelittle

不用双循环。模拟字典来个简单的哈希算法思路，以下代码仅限本题。哈希函数按不同类型，有不同算法。

1. Sub test()
   
2.     Dim arr(1 To 122), brr, crr, i, k
   
3.     brr = [a1:a13]
   
4.     ReDim crr(1 To UBound(brr))
   
5.     For i = 1 To UBound(brr)
   
6.         If arr(Asc(brr(i, 1))) = "" Then
   
7.             k = k + 1
   
8.             crr(k) = brr(i, 1)
   
9.             arr(Asc(brr(i, 1))) = 1
   
10.         End If
    
11.     Next
    
12.     Range("e1").Resize(k) = Application.Transpose(crr)
    
13. End Sub
    

复制代码

用VBA数组 双重循环去A列重复 结果保存D列.rar (8.37 KB, 下载次数: 4)

2017-3-1 20:11 上传

点击文件名下载附件

laoau138

望帝春心 发表于 2017-3-1 19:56

其实2个代码都非常好