[已解决]VBA仿照下面代码 如何实现提取A列姓名的唯一值保存D列

laoau138

VBA仿照下面代码   如何实现提取A列姓名的唯一值保存D列


'用纯数组方法 把A列姓名唯一值保存D列

'仿照下面这个代码，如何修改能不能实现

Sub hjs0()
Dim A(1 To 5)
Dim b() As String
Dim i As Integer, j As Integer
Dim n As Integer
A(1) = 1
A(2) = 2
A(3) = 1
A(4) = 3
A(5) = 3

For i = 1 To 5
  For j = i + 1 To 5
    If A(j) = A(i) Then
     A(j) = "@"
     End If
   Next j
Next i

ricks = Replace(Join(A(), ","), ",@", "")
b = Split(ricks, ",")

For s = 0 To UBound(b)
Debug.Print b(s)
Next
End Sub

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-10-27 11:53

1. Sub aaa()
   
2. Dim arr, brr, i&, j&, s$
   
3. arr = Application.Transpose(Range("a2:a" & [a65536].End(3).Row))
   
4. For i = 1 To UBound(arr) - 1
   
5.   If arr(i) <> "@" Then
   
6.     For j = i + 1 To UBound(arr)
   
7.       If arr(j) = arr(i) Then arr(j) = "@"
   
8.     Next j
   
9.   End If
   
10. Next i
    
11. s = Replace(Join(arr, ","), ",@", "")
    
12. brr = Split(s, ",")
    
13. [d2].Resize(UBound(brr) + 1) = Application.Transpose(brr)
    
14. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, j&, s$
   
3. arr = Application.Transpose(Range("a2:a" & [a65536].End(3).Row))
   
4. For i = 1 To UBound(arr) - 1
   
5.   If arr(i) <> "@" Then
   
6.     For j = i + 1 To UBound(arr)
   
7.       If arr(j) = arr(i) Then arr(j) = "@"
   
8.     Next j
   
9.   End If
   
10. Next i
    
11. s = Replace(Join(arr, ","), ",@", "")
    
12. brr = Split(s, ",")
    
13. [d2].Resize(UBound(brr) + 1) = Application.Transpose(brr)
    
14. End Sub

复制代码