[已解决]VBA比较A列唯一值 另一种方法还没有写完

laoau138

VBA比较A列唯一值   另一种方法还没有写完


Sub 比较A列唯一值()
Dim arr, i&, j&
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr) - 1
   For j = i + 1 To UBound(arr)
       If arr(i, 1) = arr(j, 1) Then arr(j, 1) = "@"
   Next
Next

'比较A列唯一值   D列保存答案   还没有写完
'假如arr 某一行不等于"@"    自动存入数组brr   请高手指导如何继续
End Sub

最佳答案

月排行榜 / 总排行榜

chart888

2017-6-13 19:53

1. Private Sub CommandButton1_Click()
   
2. Dim i&, Myr&, Arr
   
3. Dim d, k
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Myr = [A65536].End(xlUp).Row
   
6. Arr = Range("a1:a" & Myr)
   
7. For i = 1 To UBound(Arr)
   
8.     d(Arr(i, 1)) = ""
   
9. Next
   
10. k = d.Keys
    
11. [D1].Resize(d.Count, 1) = Application.Transpose(k)
    
12. Set d = Nothing
    
13. End Sub

复制代码

跳转到最佳答案楼层

chart888

1. Private Sub CommandButton1_Click()
   
2. Dim i&, Myr&, Arr
   
3. Dim d, k
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Myr = [A65536].End(xlUp).Row
   
6. Arr = Range("a1:a" & Myr)
   
7. For i = 1 To UBound(Arr)
   
8.     d(Arr(i, 1)) = ""
   
9. Next
   
10. k = d.Keys
    
11. [D1].Resize(d.Count, 1) = Application.Transpose(k)
    
12. Set d = Nothing
    
13. End Sub

复制代码

laoau138

chart888 发表于 2017-6-13 19:53

用数组不要用字典

chart888

laoau138 发表于 2017-6-13 20:17
用数组不要用字典

1. Private Sub CommandButton2_Click()
   
2. Dim arr()
   
3. Dim brr(1 To 10000, 1 To 1) As String
   
4. Dim i&, j&
   
5. Dim k&
   
6. arr = Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).Value
   
7. k = 0
   
8. For i = 1 To UBound(arr)
   
9.     For j = 1 To k
   
10.         If brr(j, 1) = arr(i, 1) Then
    
11.             Exit For
    
12.         End If
    
13.     Next j
    
14.         If j = k + 1 Then
    
15.             k = k + 1
    
16.             brr(k, 1) = arr(i, 1)
    
17.         End If
    
18. Next i
    
19. Range("D1").Resize(1000, 1) = brr
    
20. End Sub

复制代码

laoau138

chart888 发表于 2017-6-13 19:53

因为不喜欢字典    更喜欢用数组

laoau138

chart888 发表于 2017-6-13 20:32

因为太笨了，学习方式与其它人与从不同，

现在越来越少人回答我问题了

你再回答多几条问题，我就有进步了

laoau138

chart888 发表于 2017-6-13 19:53

果然是高手

怎么以前没有见过你，

chart888

laoau138 发表于 2017-6-13 22:48
果然是高手

怎么以前没有见过你，

我也是菜鸟

laoau138

chart888 发表于 2017-6-13 23:46
我也是菜鸟

你比我强N倍

laoau138

chart888 发表于 2017-6-13 23:46
我也是菜鸟

用VBA正则表达式拆分提取

第一次发问正则，高手快来解答


http://www.excelpx.com/thread-431113-1-1.html