最新WPS办公软件学习教程_免费企业办公软件下载_金山WPS Office官网论坛

 找回密码
 
查看: 11286|回复: 25

[VBA/VBS教程] 增强ET的删除重复项功能

[复制链接]

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

Rank: 14Rank: 14Rank: 14Rank: 14

该用户从未签到

金币
984
威望
8204
帖子
842
精华
3

WPS粉丝团 技术分享团 解答支持团 测试体验团 重阳节勋章 技巧教程分享达人 最佳教程奖 优秀会员奖

发表于 2012-11-11 00:08 |显示全部楼层
分享到: 新浪微博 腾讯微博
有时候删除重复项这个功能是很有用处的,很高兴,ET本身提供这个功能,让我们先学习一下:5 F% h0 \0 ~: h' L7 T

/ k, x7 X  {  H- x
" I" M6 Q  h. q/ G6 w
- C. g7 {$ n3 G& Q4 q好,看了图之后,您已经看出来了,ET中所谓的删除重复项,其实更确切地表述应该是:/ P2 ], T: s- P4 e: M
找出选中区域中的完全相同的重复不是单一的单元格),将重复的删除。
: [( J4 h1 b; c* N* q
可是,更多的时候,我们的数据单位不会是行,而是一个单元格,也就是真正的删除重复项,完整表述为:2 B9 k4 M8 \8 R' x! w% f* `
找出选中区域中的完全相同的重复就是单一的单元格),将重复的删除。$ q2 f& p  t# g+ u
很显然,当选择中区域只有一列时,上述两者等价,但选择的列不是一列而是多列时,两者是不同的。! E" i1 c* u; @0 F8 f9 o7 u# `
很可惜,ET为我们人性化地提供了删除重复行的功能,却没有为我们提供删除重复项的功能,为此,我们利用VBA自己开发一个。! t- X/ L! r6 ]: o# e' R
核心代码:
  1. Public Sub 删除重复项()$ J4 B% |9 @3 J( z  @, |+ |2 [
  2. On Error Resume Next+ O6 d0 t" D+ d& u4 {
  3. If TypeName(Selection) <> "Range" Then
    ' p9 V+ H+ }+ F) @
  4. MsgBox "您选择的不是单元格区域!", 0 + 64, "天远删除重复项"
    1 G4 D6 f1 ~# x% o0 w$ {
  5. Exit Sub '如果选择对象不是单元格则退出
      c) w4 K7 U2 c* p% i
  6. End If
    / l% _5 x3 R8 R8 n5 P
  7. If Selection.Rows.Count = Rows.Count Or Selection.Columns.Count = Columns.Count Then1 y; q7 M. h) g4 ?
  8. MsgBox "请不要选择整行整列!", 0 + 64, "天远删除重复项"8 G" y+ S2 u. u9 M+ {7 I3 C- B5 o- [
  9. Exit Sub '如果整行或者整列选择则退出" S7 m& _/ y/ S  g; |, n
  10. End If* N! v" ~( _" q. j9 J
  11. If Selection.Areas.Count > 1 Then
    1 V) a& D" ^+ i
  12. MsgBox "不能选择多个区域!", 0 + 64, "天远删除重复项"
    ! c1 f& y% |! \; l
  13. Exit Sub '如果选择多个区域则退出6 \  B- ^  D0 K$ [
  14. End If  e- B/ [8 c+ K* X; j0 E# f+ w2 `' K0 c
  15. If WorksheetFunction.CountA(Selection) < 2 Then
    ) }3 z  g& \1 p. b4 o' a
  16. MsgBox "不能只选择1个或0个非空单元格!", 0 + 64, "天远删除重复项"* K) x3 n! F$ J! g8 @$ Q+ `
  17. Exit Sub. R3 K; S3 h& p# c* Z' S/ X, p7 a
  18. End If/ d2 O! R3 r$ C+ O2 g: m8 S) T

  19. $ m0 q9 }( k- z4 f9 G
  20. Application.ScreenUpdating = False '关闭屏幕更新,加快程序执行# Q% K$ D5 ^6 Z' t$ A$ S- d3 M+ q% ~
  21. Application.Calculation = etCalculationManual '将计算模式设为手动,加快程序执行7 c1 v, L0 i  r5 b6 p2 o$ t
  22. 0 b% R3 e* Q$ a2 Y3 @3 b/ Q3 F) g
  23. Dim msg, only As New Collection, rng As Range, i As Integer
    / h. j+ Q3 q! c- q+ r3 o
  24. . k7 U3 A, W# j$ }9 X& M
  25. '选择清除方式
    ; ^" _+ t2 ^! t6 \: `7 H
  26. msg = MsgBox("选择保留第一个值请按“是”。" & vbCrLf & _3 M5 n2 {3 |( a, \& T, r2 F0 I
  27. "选择保留最后一个值请按“否”。" & vbCrLf & _3 w7 H# t  f4 D2 l6 n, y4 M
  28. "按“取消”则不进行任何操作并退出!", 3 + 32, "天远删除重复项")& d! _8 `( w1 n4 t7 T

  29. 4 t: W5 s5 r, y" h; I
  30. If 2 = msg Then Exit Sub '按取消则退出
    8 S# R2 H( K" D( K' B
  31. If 6 = msg Then '如果选择是7 p# ]6 I2 i4 Z% O+ a1 d0 \; ]
  32. For j = 1 To Selection.Count '遍历选区所有单元格- \6 o- r! b. C# E9 l& j9 ]
  33. If Selection(j) <> "" Then
    ) x, M+ V, k1 G
  34. only.Add Selection(j).Value, CStr(Selection(j).Value) '逐个导入 Collection对象. T: z7 Q, w7 S0 z' d
  35. End If3 {- v+ V- P7 O8 G7 V
  36. If Err <> 0 Then '如果有错误(重复)
    , T' e6 L, \4 D& d9 y; B$ m* U. P
  37. i = i + 1 '累加变量" i+ S1 o0 V, H, h
  38. '如果变量i为1则将 Selection(j)赋值给rng,否则将rng与 Selection(j)合并为一个Range对象
    ' l7 J5 j: @# k+ J
  39. If i = 1 Then' J( t/ d; J4 g" T  I1 X( V
  40. Set rng = Selection(j)
    & I, h0 _0 A) m
  41. Else: L4 G/ T8 P2 ]6 S8 d9 ^
  42. Set rng = Application.Union(rng, Selection(j)); V% z+ E2 v6 V
  43. End If( m7 W- H' c7 I! {3 ]2 a
  44. Err.Clear '清除错误
    7 e% l% N0 d$ S
  45. End If
    / |. j, _6 e$ V
  46. Next j; D8 }! F# K; A( u
  47. rng.Clear '清除单元格的值
    : ]" `$ b/ A/ @7 u
  48. Else  A/ Q, \0 a* l( H4 u$ o
  49. For j = 1 To Selection.Count '遍历所有单元格
    ( ^+ l# {. b' {  i8 f9 [* O, L1 ]
  50. If WorksheetFunction.CountIf(Selection, Selection(j)) > 1 Then '如果重复
    ; u  x9 K6 r7 X' i2 B3 w: a
  51. Selection(j).Clear '清除重值% y: z( Q$ I  J. R- v- a
  52. End If" N6 M, r( e& ^4 @
  53. Next j
      x. d8 l4 Z) K2 P; z& C$ {: j
  54. End If* ]' d- T0 T) Z+ G

  55. $ B8 W$ s/ n( `- }% E) t8 l
  56. Application.Calculation = etCalculationAutomatic '恢复自动计算5 m$ s9 ^' k$ F  L  O$ J
  57. Application.ScreenUpdating = True '恢复屏幕更新
    2 S9 O7 i& B% b& e
  58. End Sub
复制代码
效果图:
- M  [! u8 R) q( H1 U5 q5 S6 T, D" {6 i% @
, X0 f4 O# D4 x0 r, {+ I

& ]+ Y3 s& O5 L. m$ |1 o6 b% V! |5 D现在,实现了真正的删除重复项功能。
" n+ r  S4 `4 E1 V% @最后,附上相关文档:
2 r4 H6 F: A+ @  g8 e7 c使用本文档需要您的WPS拥有VBA环境,没有VBA环境的请到http://bbs.wps.cn/thread-22347925-1-1.html中下载安装。
5 [, l- ~7 N. [6 f5 t9 K/ ^* }5 q* N( _) v' s' M1 b% W
5 Y) R, L9 h1 ~& i

' R' i3 d6 }0 Z$ G1 U

; }* y! N0 X) D6 q) m. |4 d
" u, U9 f0 n, e3 e9 k% S* }2 r
# A4 M( Z, \9 M. Q/ B, J  A
% u, O( ^/ l0 k& }1 b

本帖子中包含更多资源

您需要 登录 才可以下载或查看,

已有 2 人评分威望 收起 理由
松风水月 + 20 赞一个!
zhouyiran1@126.com + 18 很给力!

总评分: 威望 + 38   查看全部评分

热爱分享和学习。希望WPS论坛越办越好,WPS软件越做越好。也希望能在这里交到更多志同道合的朋友。我的邮箱:ypr@yprnet.com
我在WPS论坛上的教程帖子合集: http://blog.yprnet.com/wps

153

主题

109

听众

1万

积分

解答支持团长

老菜鸟

Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20

签到天数: 240 天

[LV.8]以坛为家I

金币
1254
威望
25965
帖子
10314
精华
1

活跃会员奖 解答支持团 测试体验团 乐于助人奖 优秀会员奖

发表于 2012-11-11 00:45 |显示全部楼层
好东西,赞一个!
回复

使用道具 举报

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

Rank: 14Rank: 14Rank: 14Rank: 14

该用户从未签到

金币
984
威望
8204
帖子
842
精华
3

WPS粉丝团 技术分享团 解答支持团 测试体验团 重阳节勋章 技巧教程分享达人 最佳教程奖 优秀会员奖

发表于 2012-11-11 02:07 |显示全部楼层
这里补充说明一下:. z$ _" [7 J1 ]
无论是本贴,还是我的别一个帖子《增强ET的高亮显示重复项功能》 都用到了ET中的一个工作表函数CountIf
/ ~( o! u9 I& |- f这个函数在处理重复值时有着重要的应用,如
  1. =COUNTIF(rng,"XXX")
复制代码
将返回一个单元格区域rng中,值为"XXX"的单元格的数量,正是这个方法,我们可以判断重复值,即如果如下公式
  1. =COUNTIF(rng,cell.Text)
复制代码
的返回值大于1,则说明在单元格区域中,有与单元格cell重复的单元格。) L6 Y- r: e9 a9 J. M
! n5 X" f9 M1 |. ?+ ]* O
CountIf是一个极为强大的函数,以上只是一小方面的应用,更多资料,可以参见百度百科,我觉得上面讲的很全,是很好的学习资料。- c9 y0 o; l: P$ w# m! Q( H# Q+ Z4 M
地址: http://baike.baidu.com/view/2780729.htm
/ W4 u) @4 V" D0 R- }& r, C
热爱分享和学习。希望WPS论坛越办越好,WPS软件越做越好。也希望能在这里交到更多志同道合的朋友。我的邮箱:ypr@yprnet.com
我在WPS论坛上的教程帖子合集: http://blog.yprnet.com/wps
回复

使用道具 举报

19

主题

108

听众

5338

积分

技术分享团长

Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20

签到天数: 5 天

[LV.2]偶尔看看I

金币
5316
威望
11825
帖子
2334
精华
1

WPS粉丝团 荣誉版主奖 活跃会员奖 技术分享团 解答支持团 重阳节勋章

发表于 2012-11-14 04:53 |显示全部楼层
谢谢天远制作的脚本,ET删除重复项的方式,又多了一种选择!{:soso_e179:}
回复

使用道具 举报

0

主题

0

听众

5

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
10
帖子
3
精华
0
发表于 2013-6-3 22:34 |显示全部楼层
vba要好好学习学习
回复

使用道具 举报

1

主题

0

听众

11

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
15
帖子
9
精华
0
发表于 2013-6-23 15:11 |显示全部楼层
请教一下天远老师,有个删除重复项的问题看能否通过vba实现,谢谢!
8 ]' b1 G, y& m1 W7 C% E4 M' {1 U! Y2 }, P" M/ `
数据如下:就是要把 程序名+修改时间(最后更新时间)的唯一数据筛选出来,请教在vba如何实现,谢谢。
" G8 N1 }0 o( w1 l2 A% E+ P3 q/ }
( ?! j5 P( B# H( }2 @程序名          修改时间# J' s% |! r/ i! _
kbd078.ver    2012/10/21 16:301 U3 C3 U. W$ K( o8 H
kbd078.ver           2013/4/23 11:12
  D! c- a! d/ J  W( `1 e% j: qkbd078.ver    2013/6/22 13:29
; G0 Q( X  w0 Cfkdu01.proc  2013/6/23 13:29: L; u& @- B+ Z
fkdu01.proc 2013/3/14 14:22: J  O/ {  O! }

: Q+ f7 z. ~$ v7 k9 j最终显示结果:. Y* J4 z5 P! Q5 C/ X; k! U
程序名          修改时间& I7 o/ S' |  a0 L& j9 D
kbd078.ver    2013/6/22 13:29) W, ?+ p4 [9 U6 b8 O" }/ d
fkdu01.proc   2013/6/23 13:29
回复

使用道具 举报

5

主题

0

听众

73

积分

LV.2

Rank: 2

该用户从未签到

金币
1
威望
157
帖子
32
精华
0
发表于 2013-6-24 17:12 |显示全部楼层
那我想把重复的两个也删除呢
回复

使用道具 举报

0

主题

0

听众

55

积分

LV.2

Rank: 2

该用户从未签到

金币
0
威望
119
帖子
16
精华
0
发表于 2013-10-17 21:42 |显示全部楼层
vba要好好学习学习
回复

使用道具 举报

8

主题

0

听众

20

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
40
帖子
5
精华
0
发表于 2014-1-13 11:31 |显示全部楼层
很好  很强大
回复

使用道具 举报

6

主题

0

听众

231

积分

LV.4

Rank: 4

该用户从未签到

金币
20
威望
468
帖子
136
精华
0
发表于 2014-2-18 19:10 |显示全部楼层
& I; m/ N+ X+ H' F: @' B
签与不签,我还是会签到
回复

使用道具 举报

*滑动验证:
您需要登录后才可以回帖 登录 | 更多账号登录:

快速回帖:

fastpost

WPS论坛更新日志|WPS Office官方论坛     

GMT+8, 2017-11-25 09:52

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部