Office中国论坛/Access中国论坛

标题: 关于剔除重复 [打印本页]
作者: pureshadow    时间: 2008-3-24 15:15
标题: 关于剔除重复
这个问题曾经被无数个人问，解决的方法也是无数个。
我在这里摆个擂：

征剔除重复的方法。

要求：
1、技巧、函数、VBA不限，但请注明。
2、如果有可能就用图来说明，以方便初学者。

[ 本帖最后由 pureshadow 于 2008-3-24 16:36 编辑 ]
作者: pureshadow    时间: 2008-3-24 15:17
标题: 技巧法：高级筛选
我先来一个——技巧法：高级筛选
位置在：数据-筛选-高级筛选
把“选择不重复记录”勾上。
作者: jx1680000    时间: 2008-3-24 15:47
标题: 利用先排序后比对
[attach]29194[/attach]
作者: jx1680000    时间: 2008-3-24 15:53
标题: 利用公式，筛选
[attach]29195[/attach]
作者: jx1680000    时间: 2008-3-24 15:59
标题: 用VBA了
'利用高级筛选代码就一句话
Sub 在B列中提取A列中的不重复项()
        Sheets("test").Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), unique:=True
End Sub



Sub 不重复记录()
    '这里的序列是没有标题的;此命令只用于test表,A列
    Application.ScreenUpdating = False
    '关闭屏幕转换
    With Sheets("test")
        .Range("A:A").Sort Key1:=Range("A1"), Order1:=xlDescending
        '对序列降序排序
        Set currentcell = Range("A1")
        Do While Not IsEmpty(currentcell)
            Set nextcell = currentcell.Offset(1, 0)
            If nextcell.Value = currentcell.Value Then
                currentcell.EntireRow.Delete
            End If
            Set currentcell = nextcell
        Loop
    End With
End Sub

[attach]29196[/attach]
作者: tanhong    时间: 2008-3-24 19:43
标题: 我也来一个VBA的
VBA删除重复项，只是不是很完善，得麻烦你多点几次，直到没有重复项哦，点出来的快乐，哈哈........
Sub 删除重复()
Dim Lrow As Long
Dim I As Integer
Dim myCount
   Lrow = Sheets("sheet1").[A65536].End(xlUp).Row
   For I = 2 To Lrow
      myCount = Application.CountIf(Sheet1.Range("A2:A" & Lrow), Sheets("sheet1").Cells(I, 1))
      If myCount > 1 Then
         Sheets("sheet1").Cells(I, 1).Delete
      End If
   Next I
End Sub


[attach]29202[/attach]

实例样本：[attach]29203[/attach]

[ 本帖最后由 tanhong 于 2008-3-24 20:30 编辑 ]
作者: tanhong    时间: 2008-3-24 19:45
以上代码就当抛砖引玉，希望后面能出现更多精彩
作者: huangqinyong    时间: 2008-3-24 19:55
[:11]
作者: pureshadow    时间: 2008-3-24 23:35
标题: 技巧：数据透视表
事实上，数据透视表也不失为一个好办法，不仅可以一下子剔除重复，还可以列出每项重复了多少。

[ 本帖最后由 pureshadow 于 2008-3-24 23:40 编辑 ]
作者: huangqinyong    时间: 2008-3-24 23:40
原帖由 pureshadow 于 2008-3-24 23:35 发表
事实上，数据透视表也不失为一个好办法，不仅可以一下子剔除重复，还可以列出每项重复了多少。

有道理，用数据透视表操作简便快捷
作者: tanhong    时间: 2008-3-25 20:36
小妖有一好多法宝要慢慢亮出来,快闪.............[:33]
作者: tanhong    时间: 2008-3-25 21:40
Sub 删除重复()
Dim Lrow As Long
Dim I As Integer
Dim J As Integer
Dim myCount
   
   '关闭刷屏
  Application.ScreenUpdating = False
   
   '得到数据总行数
  Lrow = Sheets("sheet1").[A65536].End(xlUp).Row
   
  '避开标题行,即从第二行到最后一行进行循环
  For I = 2 To Lrow
      '因为考虑到进行删除操作后,需重更新得到数据总行数
      Lrow = Sheets("sheet1").[A65536].End(xlUp).Row
      '重第二行向新得到的总行数进行循环
      For J = 2 To Lrow
                 
          '按遍历单元格条件进行计数
          myCount = Application.CountIf(Sheet1.Range("A2:A" & Lrow), Sheets("sheet1").Cells(I, 1))
                  
          '计数大于1,对所在行进行删除操作
          If myCount > 1 Then
              Sheets("sheet1").Cells(I, 1).Delete
          End If
      Next J
   
   Next I
  
   '打开刷屏
  Application.ScreenUpdating = True
End Sub

以上我完善后的代码,不需要再重复点击了,哈哈....少了点击的快乐了!

[ 本帖最后由 tanhong 于 2008-3-26 19:34 编辑 ]
作者: pureshadow    时间: 2008-3-26 16:17
标题: 函数法-01
函数是有无数种解决方法的，先来一种较易理解的：

例如原数据在A2：A11，要剔除重复。

核心在于把不重复的按序排好，重复的T到一边去：
SMALL(IF(MATCH($A$2: $A$11,$A$2: $A$11,)=ROW($A$1: $A$10),ROW($A$1: $A$10),65536),ROW(A1))（计算过程如下图）

为简化公式，可以把以上自定义为focus

接下来，随你选INDEX/OFFSET/INDIRECT

=INDEX($A$2: $A$11,focus,1)
=OFFSET($A$1,focus,)
=INDIRECT("a"&focus+1)

[ 本帖最后由 pureshadow 于 2008-3-26 21:36 编辑 ]
作者: tanhong    时间: 2008-3-26 16:38
小妖版主有一大堆的方法，期待哦。。。。。。
作者: pureshadow    时间: 2008-3-26 17:09
我们约好的哦，我出多少函数，你就得出多少VBA[:34]
作者: tanhong    时间: 2008-3-26 19:34
[:30] 成心为难我哦，你储备充足..........[:27]
作者: tanhong    时间: 2008-3-26 20:30
受小妖版主技巧操作的启发，做出第三段代码，在此对小妖版主表示感谢！

主要思路：
1、首先进行排序
2、用A1=A2判断进区别是否重复，为真则表示重复
3、对为真的行进行循环删除

代码如下：

Sub 删除重复二()
Dim LRow As Long
Dim I As Integer
Dim J As Integer
Dim myBoolean As Boolean
   
   Application.ScreenUpdating = False
   
   LRow = Sheets("sheet1").[A65536].End(xlUp).Row
   '进行排序
   Range("A2:A" & LRow).Sort Key1:=Range("A2")
   
   For I = 2 To LRow

      LRow = Sheets("sheet1").[A65536].End(xlUp).Row
  
      For J = 2 To LRow
         '得到布尔值
          myBoolean = Sheet1.Range("A" & I - 1) = Sheet1.Range("A" & I)
          '值为真则进行删除
          If myBoolean = True Then
             Sheets("sheet1").Cells(I, 1).Delete
          End If
      Next J
   
   Next I
  
   Application.ScreenUpdating = True
End Sub
作者: pureshadow    时间: 2008-3-26 21:49
我也来段代码，我自己弄的，江版看了不要吐血哦[:34]

Sub M()

Dim myrow As Long
Dim myrng As Range

myrow = Range("a65536").End(xlUp).Row
Set myrng = Range("a1:a" & myrow)

myrng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True

End Sub

[ 本帖最后由 pureshadow 于 2008-3-26 21:59 编辑 ]
作者: tanhong    时间: 2008-3-26 21:59
哈哈,收网了哦,打到鱼了[:32]
作者: Jonathan.K    时间: 2008-3-27 10:03
  1. Sub test()
  2.     Dim rngData As Variant
  3.     Dim i As Long
  4.     Dim oDic As Object
  5.    
  6.     Application.ScreenUpdating = False
  7.     Set oDic = CreateObject("Scripting.Dictionary")
  8.     With Sheet1
  9.         rngData = .[a1].Resize(.[a65536].End(xlUp).Row)
  10.         For i = 1 To UBound(rngData)
  11.             oDic(rngData(i, 1)) = ""
  12.         Next
  13.         .[c1].Resize(oDic.Count) = Application.Transpose(oDic.keys)
  14.     End With
  15.     Application.ScreenUpdating = True
  16.     Set oDic = Nothing
  17. End Sub
复制代码
作者: FirstBoy    时间: 2008-3-27 10:09
高手云集!!  学习了
作者: pureshadow    时间: 2008-3-27 10:53
原帖由 Jonathan.K 于 2008-3-27 10:03 发表
Sub test()
    Dim rngData As Variant
    Dim i As Long
    Dim oDic As Object
   
    Application.ScreenUpdating = False
    Set oDic = CreateObject("Scripting.Dictionary")
    With Sheet1
  ...

谢谢师傅
学习一下[:17]
作者: tanhong    时间: 2008-3-27 11:05
原帖由 pureshadow 于 2008-3-27 10:53 发表

谢谢师傅
学习一下[:17]


小妖的师傅出马了,学习........
作者: 欢欢    时间: 2008-3-27 17:28
A2单元格数组函数公式：=IF(SUM(1/COUNTIF($A$2: $A$8,$A$2: $A$8))>=ROW(1:1),OFFSET($A$2,SMALL(IF(MATCH($A$2: $A$8,$A$2: $A$8,0)=ROW($A$2: $A$8)-1,ROW($A$2: $A$8)-1),ROW(1:1)),0,1,1),"")      下拉即可

[ 本帖最后由 pureshadow 于 2008-3-27 19:48 编辑 ]
作者: tanhong    时间: 2008-3-27 18:24
原帖由 欢欢 于 2008-3-27 17:28 发表
A2单元格数组函数公式：=IF(SUM(1/COUNTIF($A$2A$8,$A$2A$8))>=ROW(1:1),OFFSET($A$2,SMALL(IF(MATCH($A$2A$8,$A$2:$A$8,0)=ROW($A$2:$A$8)-1,ROW($A$2:$A$8)-1),ROW(1:1)),0,1,1),"")      下拉即可


欢欢的函数强哦，难怪小妖常提及。学习了
能否修改一下，可能是你的符号变成了表情动画了。
作者: pureshadow    时间: 2008-3-27 19:48
版版都可以自己动爪改的..........[:45]
作者: pureshadow    时间: 2008-3-27 19:49
爪MM也开始用E2007版了[:50]
作者: tygg    时间: 2008-5-29 10:32
客观上说,几种方法都不错,第一、第二种不用VBA方便了不会VBA的人
作者: pureshadow    时间: 2008-5-30 11:59
到我的Q空间去看吧,有剔除重复系列的......
作者: gvntw    时间: 2008-8-14 15:20
我来点：
基础操作法，没有比高级筛选不重复值更好的方法了，我就不写了，函数和VBA方法各两种。
作者: pureshadow    时间: 2008-11-12 21:57
原帖由 Jonathan.K 于 2008-3-27 10:03 发表
Sub test()
    Dim rngData As Variant
    Dim i As Long
    Dim oDic As Object
   
    Application.ScreenUpdating = False
    Set oDic = CreateObject("Scripting.Dictionary")
    With Sheet1
  ...

现在才看明白里面的意思
这恐怕是运行速度最快的一种了[:31]
作者: 洋五月    时间: 2008-11-14 19:52
呵呵，妖都才明白，我更看不懂了[:33]
作者: wait→alone    时间: 2009-3-4 01:57
数据量大的话用sql吧
Sub cx()
    Dim cnn As New ADODB.Connection
    Dim rds As New ADODB.Recordset
    Dim i As Integer
    Dim sql As String, sfilename As String, cnnstr As String
    sfilename = ThisWorkbook.FullName
    cnnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & sfilename
    sql = "select distinct * from [sheet1$]  ;"
    cnn.Open cnnstr
    rds.Open sql, cnn, adOpenKeyset, adLockOptimistic
    Sheets("sheet1").Range("b2").CopyFromRecordset rds
    rds.Close: cnn.Close
    Set rds = Nothing: Set cnn = Nothing
End Sub
作者: pureshadow    时间: 2009-3-4 09:12
SQ的速度也比不上字典，字典是VBA里比数组更快上十倍的
作者: wait→alone    时间: 2009-3-5 02:23
学习了
找时间测试下
作者: pureshadow    时间: 2009-6-1 13:35
函数是有无数种解决方法的，先来一种较易理解的：

例如原数据在A2：A11，要剔除重复。

核心在于把不重复的按序排好，重复的T到一边去：
SMALL(IF(MATCH($A$2: $A$11,$A$2: $A$11,)=ROW($A$1: $A$10),ROW($A$1 ...
pureshadow 发表于 2008-3-26 16:17

回头看看以前自己写的函数，真不是一般的烂
简化一下中间部分：
small(if(match($a$2: $a$11,$a$2: $a$11,)=row($1: $10),row($1: $10),11),row(a1))
作者: wyingnan4587    时间: 2009-6-9 15:36
还是数据透视最快了
作者: szhtct    时间: 2009-6-30 13:04
老黄历~~~
作者: douhao    时间: 2009-7-18 16:09
支持，用数据透视表操作快捷
作者: sl261011    时间: 2009-8-8 21:42
SEE
作者: sl261011    时间: 2009-8-8 22:04
SEE
作者: pcfearless    时间: 2009-8-27 14:27
新手上路说一个a列名称，不重复的放b列
在b2输入index(a:a,match(,countif(b$1:b1,a$1:a$9999),))
或者
数据在b7处INDEX($B$7B$20,SMALL(IF(ROW($B$7B$20)-6=MATCH($B$7B$20,$B$7:$B$20,0),ROW($B$7:$B$20)-6,"0"),ROW(B1)))
作者: pcfearless    时间: 2009-8-27 14:28
为 ：  $
作者: lxzxmpx    时间: 2009-12-22 10:35
学习学习
作者: 2001927f    时间: 2010-1-14 11:15
ctrl+f将“查找和替换”调出来，在“替换（p）”中的“查找内容（N）”中输入重复的内容之后先按下“查找全部（I）”后找到你要替换重复部分，然后点击全部替换就可以了，若要是将替换的部分换成空白的，你在“替换为（E）”中不输入内容就可以了啊。
个人认为我的办法最简单！
作者: dubutianxia2012    时间: 2010-5-4 22:21
3楼的方法不错
很适合我
简单实用
作者: joyark    时间: 2011-6-22 00:11
有道理，用数据透视表操作简便快捷
作者: yh0825    时间: 2011-7-24 16:51
本帖最后由 yh0825 于 2011-7-24 16:57 编辑

以上这些都是一列重复剔除的方法，但实际工作中，往往是有两列数据（或两列以上）都重复，其它列不重复，然后根据需要进行剔除的。
比如附件的例子（从其他网上转来的，VBA方法吧，非我原创，为了便于理解，数据稍微改了下）
[attach]46188[/attach]
作者: yh0825    时间: 2011-7-24 16:56
但也有局限，因为只能用max或min，比如时间这一列，我就想选重复项的第一个时间，并非max，也不是min值，那如何实现呀，我是菜鸟，不知各位老师有办法吗？
作者: xcharmer    时间: 2016-9-29 23:14
我也来一段代码，大家见笑了！
是VBA结合代码实现删除重复的
  1. Sub 删除重复()
  2.   Dim i, j
  3.     i = 1
  4.     Do While Trim(Cells(i, 1)) <> ""
  5.     '进行单循环，和老师讲解的方法不同
  6.    
  7.       Cells(i, 2) = Application.WorksheetFunction.CountIf(Range("a:a"), Range("a" & i))
  8.       '添加一个辅助列，用countif的函数进行重复数量的统计
  9.       
  10.       If Cells(i, 2) > 1 Then
  11.         '如果辅助列的数值大于1，则代表有重复数据，那么删除第一列对应的数据
  12.         
  13.       Cells(i, 1).Delete Shift:=xlShiftUp
  14.       Cells(i, 2).Delete Shift:=xlShiftUp
  15.       i = i - 1
  16.         '对I的初始恢复
  17.         
  18.       End If
  19.     i = i + 1
  20.     Loop
  21.    
  22.     Range("b:b").Delete Shift:=xlShiftUp
  23.     '将辅助列清空
  24. End Sub
复制代码
作者: 刘青梅    时间: 2016-12-4 11:50
学习



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3