求修改删除数据重复行，谢谢！

a6789 · 发表于 2019-4-21 16:08

求修改删除数据重复行，谢谢！

jiminyanyan · 发表于 2019-4-21 16:17

先做个记号，字典+数组处理就行。。。

719404338 · 发表于 2019-4-21 16:22

Sub t()
Dim i, d
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To [a65536].End(3).Row
If d.Exists(Range("a" & i).Value & Range("c" & i).Value & Range("d" & i).Value) Then
Rows(i).Delete
Else
d(Range("a" & i).Value & Range("c" & i).Value & Range("d" & i).Value) = ""
End If
Next
End Sub

复制代码

蓝桥玄霜 · 发表于 2019-4-21 16:24

请见代码。

jiminyanyan · 发表于 2019-4-21 16:26

。。。。。

a6789 · 发表于 2019-4-21 16:42

谢谢三位老师！好用，非常感谢！

tigertc · 发表于 2019-4-21 16:51

Sub lqh()
Dim arr, d
Set d = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 1) & "|" & arr(i, 3) & "|" & arr(i, 4)) Then
d(arr(i, 1) & "|" & arr(i, 3) & "|" & arr(i, 4)) = _
arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5)
End If
Next i
t = d.items: ReDim arr(1 To d.Count, 1 To 5)
For i = 0 To UBound(t)
For j = 0 To 4
arr(i + 1, j + 1) = Split(t(i), "|")(j)
Next j
Next i
Cells.Clear: [a1].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub

复制代码

a6789 · 发表于 2019-4-21 17:16

tigertc 发表于 2019-4-21 16:51

谢谢老师！非常感谢！

a6789 · 发表于 2019-4-21 17:21

tigertc 发表于 2019-4-21 16:51

有一个问题，老师可不可以修改一下，就是我的D列单元格是文本格式的，运行您的代码后变为常规格式，能否保持文本格式

a6789 · 发表于 2019-4-21 17:30

tigertc老师！帮我看看，谢谢！

		自动登录	找回密码
密码			免费注册

[求助] 求修改删除数据重复行，谢谢！