去重不干净

xing_chen

风雨声点滴 发表于 2023-7-22 18:28
Sub 去重()
    With Sheets("名称")
        R = .Cells(.Rows.Count, 1).End(xlUp).Row

谢谢老师！运行如愿

xing_chen

w4275 发表于 2023-7-22 20:40

谢谢老师！运行如愿！
抱歉！忘记回复了！
另方便话，帮我解决有条件去重代码。谢谢

准提部林

Sub TEST_A1()
Set xd = CreateObject("scripting.dictionary")
With Sheet2.Range("a1").CurrentRegion
     arr = .Value
     For i = 2 To UBound(arr)
         t = arr(i, 1): x = arr(i, 2): r = xd(t)
         If r = 0 Then n = n + 1: r = n + 1: xd(t) = r: arr(r, 1) = t: arr(r, 2) = x
         If x <> "" Then arr(r, 2) = x
     Next i
     .ClearContents
     .Range("a1").Resize(n + 1, 2) = arr
End With
End Sub

w4275

xing_chen 发表于 2023-7-24 14:57
谢谢老师！运行如愿！
抱歉！忘记回复了！
另方便话，帮我解决有条件去重代码。谢谢

条件去重.7z (18.75 KB, 下载次数: 5)

2023-7-24 17:55 上传

点击文件名下载附件

xing_chen

准提部林 发表于 2023-7-24 15:40
Sub TEST_A1()
Set xd = CreateObject("scripting.dictionary")
With Sheet2.Range("a1").CurrentRegion
...

谢谢老师！一上网就看见你消息，知道这下有希望了。运行如愿。
抱歉！花在旅途，到时献上。

xing_chen

w4275 发表于 2023-7-24 17:33

谢谢老师！运行如愿

xing_chen

w4275 发表于 2023-7-24 17:33

抱歉！老师！花在旅途到时献上