满足两个条件，清空重复值并保持格式不变

iris00

yaofengda 发表于 2024-5-9 18:12
Sub test()
Dim Arr, D, i&, N$
Arr = Range([F2], [C65536].End(3))

谢谢！！！

iris00

Qs18 发表于 2024-5-9 18:56
Sub test()
Dim dic As Object, t, i, arr
Set dic = CreateObject("scripting.dictionary")

谢谢！！！

iris00

yanglinzi 发表于 2024-5-9 20:26
参与一下。。

谢谢！！！

iris00

全党 发表于 2024-5-10 09:18

谢谢！！！

全党

iris00 发表于 2024-5-10 09:36
谢谢！！！

重新给你简化了一下，你再试试。。。。

1. Sub shishi()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. arr = [c2].CurrentRegion
   
4. For i = 1 To UBound(arr)
   
5. Key = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3)
   
6. d(Key) = 0
   
7. Next
   
8. For i = 1 To UBound(arr)
   
9.     ss = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3)
   
10.     If d.exists(ss) Then
    
11.     d(ss) = d(ss) + 1
    
12.         If d(ss) > 1 Then
    
13.         arr(i, 4) = ""
    
14.         End If
    
15.     End If
    
16. Next
    
17. [o2].Resize(UBound(arr), 4) = arr
    
18. End Sub
    

复制代码

iris00

全党 发表于 2024-5-10 12:09
重新给你简化了一下，你再试试。。。。

好的，非常感谢！！！

iris00

gwjkkkkk 发表于 2024-5-9 18:23
请参考附件。。。

请教下，如果还有一列需要C,E两列相同时，清空G列重复项。（假设G列有内容）代码要如何写呢？

iris00

全党 发表于 2024-5-10 12:09
重新给你简化了一下，你再试试。。。。

不需要另外的位置显示，只是原来的重复项清空就好。代码要怎么写呢？

全党

iris00 发表于 2024-5-11 09:16
不需要另外的位置显示，只是原来的重复项清空就好。代码要怎么写呢？

[o2].Resize(UBound(arr), 4) = arr
改为：[c2].Resize(UBound(arr), 4) = arr

iris00

全党 发表于 2024-5-11 10:44
[o2].Resize(UBound(arr), 4) = arr
改为：[c2].Resize(UBound(arr), 4) = arr

谢谢！！！