在指定的一个或多个单元格区域内，把完全相同的单元格全部都清空，如果只保留一个

gaoch35 · 发表于 2014-11-30 14:52

本帖最后由 gaoch35 于 2014-12-3 11:57 编辑

图片2.png

只保留完全相同的一个

图片中选择的单元格区域为a3:b17和c5:d21两个单元格区域，第1张图片为原表，第2张图片为清空全部完全相同的单元格后的表，第3张图片为只保留完全相同的一个后的表，那些标有x的单元格为没有相同的，清空前后那些单元格不变。
选择两个及以上单元格区域，就把那些区域当成一个整体，把整体里完全相同的单元格全部都清空掉，如果是只保留一个呢

liulang0808 · 发表于 2014-11-30 15:00

附件中没有代码，需要修改什么？

liulang0808 · 发表于 2014-11-30 15:07

Sub 按钮1_Click()
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
Dim rng As Range
For j = 1 To Cells(Rows.Count, "a").End(3).Row
      If Len(Cells(j, "a")) > 0 Then d(Cells(j, "a").Value) = 1 + d(Cells(j, "a").Value)
Next j
For j = 1 To Cells(Rows.Count, "a").End(3).Row
      If Len(Cells(j, "a")) > 0 And d(Cells(j, "a").Value) > 1 Then
         If rng Is Nothing Then
            Set rng = Cells(j, "a")
         Else
            Set rng = Union(Cells(j, "a"), rng)
         End If
      End If
Next j
If Not rng Is Nothing Then rng.Delete
Application.ScreenUpdating = True
End Sub

liulang0808 · 发表于 2014-11-30 15:08

"a" 修改为 "b" 就是删除b列的了

gaoch35 · 发表于 2014-11-30 17:13

本帖最后由 gaoch35 于 2014-11-30 17:18 编辑

liulang0808 发表于 2014-11-30 15:08
"a" 修改为 "b" 就是删除b列的了

如果是把B、D两列完全相同的全部都删除掉呢？B列有几个和D列的是完全相同的

liulang0808 · 发表于 2014-11-30 17:19

将判断的内容修改一下就可以了吧

gaoch35 · 发表于 2014-11-30 18:03

liulang0808 发表于 2014-11-30 17:19
将判断的内容修改一下就可以了吧

坑爹你给的不正确，A列中完全相同的有3对共6个，原来A列中有18个单元格，减去6个应该是12个，你的怎么是15个

liulang0808 · 发表于 2014-11-30 18:11

gaoch35 发表于 2014-11-30 18:03
坑爹你给的不正确，A列中完全相同的有3对共6个，原来A列中有18个单元格，减去6个应该是12个，你的怎么是1 ...

不好意思，能力有限
不欠你什么吧

gaoch35 · 发表于 2014-12-1 09:55

哪位大师帮帮忙，谢谢

Vicel · 发表于 2014-12-1 12:47

代码如下，楼主按需要再改进改进吧

Sub SC2() '删除两列所有重复单元格（可以是连续两列，也可以是不连续两列）
Application.ScreenUpdating = False
C1 = "A"
C2 = "B"
n1 = Cells(Rows.Count, C1).End(xlUp).Row
n2 = Cells(Rows.Count, C2).End(xlUp).Row
rng1 = C1 & "1:" & C1 & n1
rng2 = C2 & "1:" & C2 & n2
Union(Range(rng1), Range(rng2)).Select
For Each cell In Selection
s = 0
T = cell.Value
If T <> "" And Trim(T) <> "" Then
s = Application.CountIf(Range(rng1), T) + Application.CountIf(Range(rng2), T)
End If
If s > 1 Then
Selection.Find(What:=T, After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Delete
Do
Selection.FindNext(After:=ActiveCell).Delete
s = s - 1
Loop While s > 1
End If
Next
Application.ScreenUpdating = True
End Sub
Sub SC() '删除连续区域（一列或多列连续）所有重复单元格
Application.ScreenUpdating = False
For Each cell In Selection
s = 0
T = cell.Value
If T <> "" And Trim(T) <> "" Then
s = Application.CountIf(Selection, T)
End If
If s > 1 Then
Selection.Find(What:=T, After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Delete
Do
Selection.FindNext(After:=ActiveCell).Delete
s = s - 1
Loop While s > 1
End If
Next
Application.ScreenUpdating = True
End Sub

复制代码

删除重复.rar (6.97 KB, 下载次数: 19)

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

[求助] 在指定的一个或多个单元格区域内，把完全相同的单元格全部都清空，如果只保留一个