[已解决]按条件返回唯一值

yewei113

去除重复，只留一个就行

最佳答案

月排行榜 / 总排行榜

冥王

2015-8-2 12:13

1. Sub demo()
   
2.     Dim arr, i%, n%, d1, d2, dic As Object
   
3.     Set dic = CreateObject("Scripting.Dictionary")
   
4.     With ThisWorkbook
   
5.         arr = .Sheets(2).Range("A1").CurrentRegion
   
6.         d1 = .Sheets(1).[I1]
   
7.         d2 = .Sheets(1).[K1]
   
8.         For i = LBound(arr) + 1 To UBound(arr)
   
9.             If arr(i, 2) >= d1 And arr(i, 2) <= d2 And arr(i, 8) <> "本货站" And (arr(i, 10) = "厂家A" Or arr(i, 10) = "厂家B") Then
   
10.                 dic(arr(i, 8)) = ""
    
11.             End If
    
12.         Next
    
13.         .Sheets(1).Range("A1:F1").ClearContents  '清除A1:F1内容
    
14.         .Sheets(1).Range("A1").Resize(1, dic.Count) = dic.keys
    
15.     End With
    
16. End Sub

复制代码

跳转到最佳答案楼层

冥王

1. Sub demo()
   
2.     Dim arr, i%, n%, d1, d2, dic As Object
   
3.     Set dic = CreateObject("Scripting.Dictionary")
   
4.     With ThisWorkbook
   
5.         arr = .Sheets(2).Range("A1").CurrentRegion
   
6.         d1 = .Sheets(1).[I1]
   
7.         d2 = .Sheets(1).[K1]
   
8.         For i = LBound(arr) + 1 To UBound(arr)
   
9.             If arr(i, 2) >= d1 And arr(i, 2) <= d2 And arr(i, 8) <> "本货站" And (arr(i, 10) = "厂家A" Or arr(i, 10) = "厂家B") Then
   
10.                 dic(arr(i, 8)) = ""
    
11.             End If
    
12.         Next
    
13.         .Sheets(1).Range("A1:F1").ClearContents  '清除A1:F1内容
    
14.         .Sheets(1).Range("A1").Resize(1, dic.Count) = dic.keys
    
15.     End With
    
16. End Sub

复制代码

yewei113

冥王 发表于 2015-8-2 12:13

有函数解法吗