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

iris00

C,D两列条件相同的内容，F列清空重复值，格式不变。VBA小白请大家帮忙。搜了下，多数都是删除重得行，或者重新排列，我的要求是要保持格式不变，就是清空重复项，便于后续统计计算。

蓝桥玄霜

重复的例子：

yaofengda

Sub test()
Dim Arr, D, i&, N$
Arr = Range([F2], [C65536].End(3))
Set D = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
    N = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 4)
    If D(N) = Empty Then D(N) = Arr(i, 4): GoTo 101
    If Arr(i, 4) = D(N) Then Arr(i, 4) = Empty
101: Next
[I2].Resize(i - 1, 4) = Arr
End Sub

gwjkkkkk

Option Explicit
Sub TEST5()
    Dim ar, i&, r&, strKey$, dic As Object
   
    Set dic = CreateObject("Scripting.Dictionary")
   
    r = Cells(Rows.Count, "C").End(xlUp).Row
    ar = Range("C2:F" & r).Value
    For i = 1 To UBound(ar)
        strKey = ar(i, 1) & "," & ar(i, 2)
        If Not dic.exists(strKey) Then
            dic(strKey) = ar(i, 4)
        Else
            If ar(i, 4) = dic(strKey) Then ar(i, 4) = Empty
        End If
    Next i
   
    [C2].Resize(UBound(ar), UBound(ar, 2)) = ar
    Set dic = Nothing
    Beep
End Sub

gwjkkkkk

请参考附件。。。

Qs18

Sub test()
Dim dic As Object, t, i, arr
Set dic = CreateObject("scripting.dictionary")
arr = Sheet2.Range([c2], Cells(Rows.Count, "f").End(xlUp))
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = LBound(arr) To UBound(arr)
    t = arr(i, 1) & "#" & arr(i, 2)
    If Not dic.exists(t) Then
        dic(t) = ""
        brr(i, 1) = arr(i, 1)
        brr(i, 2) = arr(i, 2)
        brr(i, 3) = arr(i, 3)
        brr(i, 4) = arr(i, 4)
    Else
        brr(i, 1) = arr(i, 1)
        brr(i, 2) = arr(i, 2)
        brr(i, 3) = arr(i, 3)
        brr(i, 4) = ""
    End If
Next i
Sheet2.Range("i2").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

yanglinzi

1. Sub 清空重复值()
   
2. Dim r, i, j, d
   
3. Set d = CreateObject("scripting.dictionary")
   
4. With Sheet3
   
5.     r = .Cells(Rows.Count, "c").End(xlUp).Row
   
6.     arr = .Range("c2:f" & r)
   
7. End With
   
8. For i = 1 To UBound(arr)
   
9.     sa = arr(i, 1) & "|" & arr(i, 2)
   
10.     If Not d.exists(sa) Then
    
11.         d(sa) = arr(i, 4)
    
12.     Else
    
13.         Cells(i + 1, "f").ClearContents
    
14.     End If
    
15. Next
    
16. End Sub
    

复制代码

yanglinzi

参与一下。。

全党

1. <blockquote><span style="font-size: 14px;">Sub shishi()</span>

复制代码

iris00

蓝桥玄霜 发表于 2024-5-9 17:52
重复的例子：

非常感谢！！！