用VBA数组不相同字母取出来放F列

laoau128

用VBA数组不相同字母取出来放F列

huang1314wei

楼主你好，好久不见

yeminqiang

Sub cdsr()
Dim arr
arr = Range("a1:d12")
Set d = CreateObject("scripting.dictionary")
For Each k In arr
d(k) = ""
Next
[f2].Resize(d.Count, 1) = Application.Transpose(d.keys)
End Sub

Chip_Kenny

來個純数组

1. Sub zz()
   
2. Dim ar, a(), n&
   
3. ar = [a1:d12]
   
4. ReDim a(UBound(ar) * UBound(ar, 2))
   
5. a(0) = "D"
   
6. For Each k In ar
   
7.     If UBound(Filter(a, k)) = -1 Then a(n) = k: n = n + 1
   
8. Next
   
9. ReDim Preserve a(n)
   
10. [f2].Resize(n + 1) = Application.Transpose(a)
    
11. End Sub

复制代码

wuliu56

1. Sub test()
   
2. Dim x, y, z, n, m
   
3. Dim brr(), arr
   
4. arr = Range("a1:d12")
   
5. For x = 1 To UBound(arr)
   
6.     For y = 1 To UBound(arr, 2)
   
7.         If arr(x, y) Like "[D-W]" Then
   
8.             n = n + 1
   
9.             ReDim Preserve brr(1 To n)
   
10.             For z = 1 To n
    
11.                 If arr(x, y) = brr(z) Then GoTo 100
    
12.             Next
    
13.         m = m + 1
    
14.         brr(m) = arr(x, y)
    
15.         End If
    
16. 100:
    
17.     Next
    
18. Next
    
19. Range("f2").Resize(m) = Application.Transpose(brr)
    
20. End Sub
    

复制代码

laoau128

huang1314wei 发表于 2017-3-22 13:53
楼主你好，好久不见

见笑了，天天都在论坛，怎么会好久不见

laoau128

wuliu56 发表于 2017-3-22 14:33

高手  好多天没有见过你了

wuliu56

laoau128 发表于 2017-3-22 15:49
高手  好多天没有见过你了

高手不敢当。确实好久没来论坛了。

xiangbaoan

Sub test()
Dim Arr, Brr(), d%, w%, r&, c%, n%
Arr = [a1].CurrentRegion.Resize(, 4)
d = Asc("D")
w = Asc("W")
ReDim Brr(d To w, 1 To 1)
For r = 1 To UBound(Arr)
    For c = 1 To UBound(Arr, 2)
        n = Asc(Arr(r, c))
        If n >= d And n <= w Then Brr(n, 1) = Arr(r, c)
    Next
Next
With [f2].Resize(w - d + 1, 1)
    .Value = Brr
    .Sort [f2], 1, Header:=2 '排序
End With
End Sub

laoau128

wuliu56 发表于 2017-3-22 14:33

用VBA数组提取相同姓名连续天数



http://club.excelhome.net/thread-1335791-1-1.html