如何使用函数筛选去重复，重复的只保留1个

my0745

ChangeKing7 发表于 2023-5-19 09:30
加个辅助列 用filter筛一下 标题行可以用vstack堆一个或者copy过来
供参考

感谢解答。。

niko88819

1. Sub niko()
   
2.     Dim ws As Worksheet
   
3.     Dim rng As Range
   
4.     Dim cell As Range
   
5.     Dim sValues As Object
   
6.     Dim outputRange As Range
   
7.     Dim outputCell As Range
   
8.     Set ws = ThisWorkbook.Worksheets("Sheet1")
   
9.     Set rng = ws.Range("A2:C12")
   
10.     Set outputRange = ws.Range("K2:M2")
    
11.     Set sValues = CreateObject("Scripting.Dictionary")
    
12.     For Each cell In rng.Rows
    
13.         If Not sValues.Exists(cell.Cells(1, 1).Value) Then
    
14.             sValues.Add cell.Cells(1, 1).Value, True
    
15.             Set outputCell = outputRange.Offset(sValues.Count - 1).Resize(1, 3)
    
16.             outputCell.Value = cell.Value
    
17.         End If
    
18.     Next cell
    
19. End Sub

复制代码