|
- Sub 提取不重复姓名()
- Dim arr, i&, d, x
- arr = Sheets(1).[a1].CurrentRegion
- Set d = CreateObject("scripting.dictionary")
- For i = 1 To UBound(arr)
- x = arr(i, 1)
- If Len(x) > 1 Then
- d(x) = ""
- End If
- Next
- With Sheets(2)
- .[b9:b10000].ClearContents
- .[b9].Resize(d.Count, 1) = Application.Transpose(d.keys)
- End With
- End Sub
复制代码 |
评分
-
查看全部评分
|