利用数组的方法去重复制到指定单元格

格调是我

各位老铁能帮忙写个VBA代码吗？

选中区域，定义数组后，去重复，到指定单元格SHEET2  RANGE"D9"

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Worksheets("sheet1")
   
7.         If Selection.Cells.Count = 1 Then
   
8.             ReDim arr(1 To 1, 1 To 1)
   
9.             arr(1, 1) = Selection
   
10.         Else
    
11.             arr = Selection
    
12.         End If
    
13.         For i = 1 To UBound(arr)
    
14.             For j = 1 To UBound(arr, 2)
    
15.                 If Len(arr(i, j)) <> 0 Then
    
16.                     d(arr(i, j)) = Empty
    
17.                 End If
    
18.             Next
    
19.         Next
    
20.     End With
    
21.     With Worksheets("sheet2")
    
22.         .Range("d9:d" & .Rows.Count).Clear
    
23.         If d.Count > 0 Then
    
24.             .Range("d9").Resize(d.Count, 1) = Application.Transpose(d.keys)
    
25.         End If
    
26.     End With
    
27. End Sub
    

复制代码

chxw68

详见附件。

杨建营

请楼主参考。

格调是我

杨建营 发表于 2023-3-5 08:39
请楼主参考。

谢谢老铁

leolee82

排序，去重，恢复排序