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

gaoch35

Vicel 发表于 2014-12-3 12:06
区域可自由更改，能处理交叉单元格问题，可选择清空或删除多余重复单元格

帮帮忙，谢谢，在指定的一个或多个单元格区域内，把完全相同的单元格全部都提取出来复制到指定的列中
http://club.excelhome.net/thread-1170309-1-1.html

gaoch35

Vicel 发表于 2014-12-3 12:06
区域可自由更改，能处理交叉单元格问题，可选择清空或删除多余重复单元格

你给的代码如果只是清空的话，就删除掉哪几行代码，第29楼的第1个

Vicel

gaoch35 发表于 2014-12-4 20:26
你给的代码如果只是清空的话，就删除掉哪几行代码，第29楼的第1个

41行后面不是有注释吗？看不懂？

gaoch35

Vicel 发表于 2014-12-4 20:49
41行后面不是有注释吗？看不懂？

第29楼的第一个代码只能把完全相同的清空一个，其他的代码也一样

gaoch35

Vicel 发表于 2014-12-4 20:49
41行后面不是有注释吗？看不懂？

怎么有两个完全相同的要连续运行两次才能把两个都清空，有三个完全相同的要连续运行三次才能把三个都清空，有四个完全相同的要连续运行四次 .....，最后完全相同的还保留了一个

Vicel

gaoch35 发表于 2014-12-5 11:24
怎么有两个完全相同的要连续运行两次才能把两个都清空，有三个完全相同的要连续运行三次才能把三个都清空 ...

楼主，说真的，我很怀疑你的理解能力，不知楼主你是怎样操作的
如下图，清空前共有5组完全重复的单元格

选择A1：E39区域后（当然也可以选择重叠的区域），执行29楼的代码2（这里删除了37行，用上38、39行的代码）

1. Sub SC()
   
2.    
   
3.     Dim rng As Range, cell As Range, d As Object, dd As Object, s As Integer, n As Integer, Z As String, T As String
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set dd = CreateObject("scripting.dictionary")
   
6.     Application.ScreenUpdating = False
   
7.     s = 0: n = 0
   
8.     For Each cell In Selection
   
9.         Z = cell.Address(0, 0)
   
10.         T = cell.Value
    
11.         If Not d.exists(Z) Then
    
12.             s = s + 1
    
13.             d.Add Z, T
    
14.             If T = "" Then
    
15.                 GoTo 1         '单元格值为空直接往下一单元格
    
16.             ElseIf Trim(T) <> "" Then
    
17.                 If Not dd.exists(T) Then
    
18.                     dd.Add T, Z
    
19.                     k = dd.Item(T)
    
20.                 ElseIf Z <> dd.Item(T) Then
    
21.                     n = n + 1
    
22.                     If rng Is Nothing Then
    
23.                         Set rng = cell
    
24.                     Else
    
25.                         Set rng = Union(rng, cell)
    
26.                     End If
    
27.                 End If
    
28.             Else
    
29.                 cell.Value = ""
    
30.             End If
    
31.         Else
    
32.             GoTo 1             '单元格为已查询过的，直接往下一单元格
    
33.         End If
    
34. 1:  Next
    
35.     d.RemoveAll
    
36.     rng.Select
    
37.     Selection.Clear
    
38.     MsgBox "共选择了" & s & "个单元格，其中" & n & "个重复单元格已被清空"
    
39.     Application.ScreenUpdating = True
    
40.    
    
41. End Sub
    

复制代码

得到下图的结果（完全重复的单元格只保留一个，其余已经清空）