关于剔除重复

tanhong

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




实例样本：

[ 本帖最后由 tanhong 于 2008-3-24 20:30 编辑 ]

tanhong

以上代码就当抛砖引玉，希望后面能出现更多精彩

tanhong

小妖有一好多法宝要慢慢亮出来,快闪.............[:33]

tanhong

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 编辑 ]

tanhong

小妖版主有一大堆的方法，期待哦。。。。。。

tanhong

[:30] 成心为难我哦，你储备充足..........[:27]

tanhong

受小妖版主技巧操作的启发，做出第三段代码，在此对小妖版主表示感谢！

主要思路：
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

tanhong

哈哈,收网了哦,打到鱼了[:32]

tanhong

原帖由 pureshadow 于 2008-3-27 10:53 发表

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

小妖的师傅出马了,学习........

tanhong

原帖由 欢欢 于 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),"")      下拉即可

欢欢的函数强哦，难怪小妖常提及。学习了
能否修改一下，可能是你的符号变成了表情动画了。