根据ABCD列数据结构，想要得到E列结果

longnose

不知道怎么描述了，就是根据附件ABCD列数据结果，想要得到E列结果。麻烦大神帮忙写一段VBA代码实现该要求，多谢！

笨鸟飞不高

根据ABCD列数据结构，得到E列结果.zip (18.13 KB, 下载次数: 11)

2024-5-26 08:55 上传

点击文件名下载附件

猜一个！

lizhipei78

好久不写代码了，都生疏完了

lizhipei78

1. Sub test()
   
2.     Dim i&, Arr, d As Object, dd As Object
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set dd = CreateObject("Scripting.Dictionary")
   
5.     Range("A1").CurrentRegion.Offset(1, 4).ClearContents
   
6.     Arr = Range("A1").CurrentRegion
   
7.     For i = 2 To UBound(Arr)
   
8.         s = Arr(i, 2)
   
9.         ss = Arr(i, 2) & "|" & Arr(i, 3)
   
10.         If Not d.Exists(s) Then
    
11.             Set d(s) = CreateObject("Scripting.Dictionary")
    
12.         End If
    
13.         d(s)(Arr(i, 3)) = i
    
14.         If Not dd.Exists(ss) Then
    
15.             Arr(i, 5) = "保留"
    
16.             dd(ss) = ""
    
17.             Else: Arr(i, 5) = "删除"
    
18.         End If
    
19.     Next
    
20.     For Each k In d.keys
    
21.         For Each kk In d(k).items
    
22.             If Arr(kk, 3) = Empty And UBound(d(k).keys) Then
    
23.                 Arr(kk, 5) = "删除"
    
24.             End If
    
25.         Next
    
26.     Next
    
27.     Range("E1").Resize(UBound(Arr), 1) = Application.Index(Arr, 0, 5)
    
28. End Sub
    
29. 
    
30. 
    
31. 
    

复制代码

cidanji

1. Sub 需求猜测()
   
2. Dim ar, i&, rg As Range, d As Object, x, y
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set rg = Range("A1:E" & Cells(Rows.Count, 2).End(3).Row)
   
5. ar = rg.Value
   
6. For i = UBound(ar) To 2 Step -1
   
7.     x = ar(i, 2): y = ar(i, 3)
   
8.     If Not d.exists(x) Then Set d(x) = CreateObject("scripting.dictionary")
   
9.     d(x)(y) = i
   
10. Next
    
11. For i = 2 To UBound(ar)
    
12.     x = ar(i, 2): y = ar(i, 3)
    
13.     ar(i, 5) = IIf(d(x)(y) = i And (d(x).Count = 1 Or y <> ""), "保留", "删除")
    
14. Next
    
15. rg = ar
    
16. End Sub

复制代码