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

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

[VBA/VBS教程] 天远ET工具箱新功能介绍及源代码解读2——数值定位

[复制链接]

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2013-2-23 00:29 |显示全部楼层
分享到: 新浪微博 腾讯微博
本帖最后由 天远 于 2013-2-28 12:46 编辑
* G3 @+ {* x/ ^' w/ H2 S& g) L. C+ Y/ J9 V3 n" R
从今天开始,我将对天远ET工具箱中的新功能进行分别介绍,并解读其实现的源代码,帮助大家更好地学习VBA.4 ?  V  T8 w+ x) ]
8 f; o0 A3 h: _/ H
先来看这个功能0 a1 X: @( E$ {; j. J+ |, L

3 [- k6 w3 {9 [  E. \- z2 P1 A0 `

! y% n! \+ x4 _% I* x/ z" e1 N( e( B) e  x; k. I6 U* C
下面,来详细解读实现这个功能源代码:01 '定位选区特定数值单元格
; s0 k; J/ @' F8 I" t02 '接受2个参数,其中Types代表操作类型,ci代表基准数值,Types的意义如下
& N2 S' A4 N# Y5 c. q1 X3 h  ?03 '1 =! S. l3 k9 a! p" W# S7 F
04 '2 >: T$ z& W$ Z' q, E7 ~
05 '3 >=
; [: ^% s7 o8 B! x  D06 '4 </ A8 S6 L/ s- T1 D0 m3 w& |- U
07 '5 <=
& n9 E0 t" h+ N) r, ~08 '6 <>; y7 M: ]+ [0 L# ~5 r
09 Sub TYSelectSelectionValueRange(ByVal Types As Integer, ByVal ci As Long)
1 x  b1 d) x; [/ p+ D1 t10 On Error GoTo myErr '错误处理0 u. U$ ~) G- ?" J  I8 }# `7 l3 N) U
11 Application.ScreenUpdating = False '关闭屏幕更新,加快速度
( _9 d: Z/ M4 T4 A8 m6 w+ [" N. V12 If TypeName(Selection) <> "Range" Then GoTo myExit  ' 选择对象不是单元格则退出+ i+ B5 W5 h" P1 j2 b
13 Dim rng, rngg, rnggEx As Range% ~6 O# {5 J5 P. c/ k
14 Set rnggEx = Application.Intersect(Application.ActiveSheet.UsedRange, Selection) '取得整个区域$ V% e- ~% N$ g' f1 Z
15 If 0 = rnggEx.Count Then GoTo myExit '选区为空是退出
/ d; ?+ T9 G4 g1 c) ?* {16 Dim toUnion, isOk As Boolean 'toUnion表征是否已经有满足定位条件的单元格,isOk代表单元格内的数值是否满足定位条件
% B& s- l! D1 h0 M6 _1 N+ E17 toUnion = False- q! E3 z4 s9 K
18 Dim myci As Long  J" t/ [  c7 }* o2 A4 @
19 For Each rng In rnggEx '对选区的每一个单元格进行操作
& a: J9 S+ |; y% D2 v3 f. P20     myci = rng.Value '取得单元格的数值
/ I# o$ L6 V% E5 t' ~21     isOk = False '初始化isOK
( W8 W$ ]0 ~$ ]4 ~2 G! ]' J22     Select Case Types '判断操作类型
# H% Y+ [& e4 w" O; g23     Case 1
; [3 r! v1 B% m5 U3 ?0 A24         If myci = ci Then isOk = True '用isOk代表单元格内的数值是否满足定位条件,下同, r$ A8 `8 K! e7 d1 H4 ^! }; L
25     Case 2  ~  V* `8 T- ^' r
26         If myci > ci Then isOk = True- r8 t1 n& X' r
27     Case 3
$ a" J* B  b% o6 _4 i9 q+ d28         If myci >= ci Then isOk = True
& @/ K& S' ?% g3 N1 v29     Case 4
2 n" W) p7 Z7 I' H30         If myci < ci Then isOk = True; X1 h$ L# _5 I! Z2 ^2 b9 C
31     Case 5
: b- Y2 U7 j5 ~$ h32         If myci <= ci Then isOk = True
: }( o- Z- u% l) x9 J2 j33     Case 6
3 e& I7 }% t4 w6 [( S34         If myci <> ci Then isOk = True
+ f; k, i! W7 c- q- W! ~35     End Select8 I7 }) ~1 F0 P9 z; p& Y
36     If True = isOk Then '如果单元格内的数值满足定位条件
& @% R  O4 v7 V: v, b9 v& `37         If True = toUnion Then '如果已经有要定位的单元格. Q" Q# u9 O8 W) u: X' b5 N
38             Set rngg = Union(rngg, rng) '则把新单元格加入到rngg中; L- T! [. ]2 N4 _
39         Else/ A& @8 X2 Q5 n) Z
40             Set rngg = rng '否则用rng初始化rngg
  Z% \4 T5 X* m& d8 N41             toUnion = True '并调整toUnion
6 w' ?5 S: K4 Y. ^# a; D42         End If
0 D9 M+ G" Y! N3 J% C6 H43     End If6 l' p: S4 a% `/ t2 }5 }; {
44 Next0 L. V' k9 J6 u, R
45 rngg.Select '将rngg设置成选中状态% r, ]  p' K6 Z1 R4 S+ E5 T
46 Application.ScreenUpdating = True '恢复屏幕更新' A8 m0 `# {* V( s5 Q+ x6 h$ u
47 myErr:
: j3 w  z: J3 t2 t) ^! I48 myExit:# \+ W- y- G# i7 ~' Z- u5 q
49 End Sub% u; `+ W! [0 c- U( q' C' i# \7 ?
50
0 q  S0 q" k3 {0 Q51 Public Sub TYSelectSelectionValueRangeSub(); k; J$ F, `. N) \1 `- @
52 On Error GoTo myErr
! I/ w7 Y0 A0 r7 v: \53 Dim intputStr1, intputStr2, str As String9 I4 _1 T5 X+ }* x, k9 P3 W
54 Dim i As Integer, D& D8 c3 U8 e: g% \
55 str = "请选择数值定位类型:" & vbCrLf & vbCrLf4 r5 @2 F$ Y$ r: k9 Q) o& G' n9 ?
56 str = str & "1:=" & vbCrLf
: L6 u# J$ E$ s57 str = str & "2:>" & vbCrLf. J: ]4 u; t8 O# b' }
58 str = str & "3:>=" & vbCrLf, @1 U  R$ r: l/ B6 h2 y1 p5 s
59 str = str & "4:<" & vbCrLf
+ J) y5 m% U7 w7 s2 A- E0 j60 str = str & "5:<=" & vbCrLf
6 d4 \% s; |" T+ B61 str = str & "6:<>" & vbCrLf
/ K9 D) L- A4 ?! [1 L62 str = str & vbCrLf & "(输入其他内容时退出本操作)" & vbCrLf
( K# _+ T5 }- l$ L# G63
) u6 `; S- C/ Y8 @% x6 l$ Q64 intputStr1 = InputBox(str, "天远ET工具箱", 1) '获取用户输入的操作类型( K9 H- P8 c- V1 s1 t' H+ G* ]4 E
65 i = Val(intputStr1)
1 Y; R0 o9 D3 z* p- I( w$ L66 If i < 1 Or i > 6 Then GoTo myExit
& a4 d# y/ g9 I4 S67 intputStr2 = InputBox("请输入基准数值:", "天远ET工具箱", 0) '获取用户输入的基准数值
+ M7 P; R9 c+ Y4 u5 `' ^1 r68 Call TYSelectSelectionValueRange(i, Val(intputStr2)) '用获取的数据用参数调用TYSelectSelectionValueRange' e& @  k1 O: z( s5 V3 [2 ]$ S7 Y" G
69 myErr:
1 \5 V1 q0 ]; P) {8 \  e  O1 E6 h70 myExit:) A8 @0 X/ Y4 e5 A' @- Q4 B8 t. v
71 End Sub6 J. {1 Q& Z. ?9 c' O7 b0 Z
* T  U. C3 l5 [: [: f: s: a
+ e% \1 G1 l0 O* d
所有源代码见附件(欢迎VBS爱好者把这些代码改写成VBS脚本,可以更加方便地脱离VBA环境使用)
3 a! H" t! m/ c附件:" v! ]2 o3 c9 N/ T
天远数值定位功能VBA版:
3 L+ `$ b" z8 K  H2 u! J  a" P1 ?  R
游客,如果您要查看本帖隐藏内容请回复
2 Z7 ^% C; a8 ]9 y8 K: z
(使用本文档需要您的WPS拥有VBA环境,没有VBA环境的请到http://bbs.wps.cn/thread-22347925-1-1.html中下载安装。)5 R4 k+ P9 v) V; d+ v3 r- K2 x
使用天远ET工具箱不需要VBA环境,天远ET工具箱即将加入数值定位功能,敬请期待。3 a9 e  _* d2 J; u! ?0 `" A9 o2 C
7 z1 y$ f: `9 S: \7 ^7 Z2 e

数值定位这个功能的灵感来自于罗刚君老师在2009年于WPS论坛发表的帖子——全方位强化ET的查找功能(升级3.0版)。上面介绍了全方位强化ET的查找功能插件(安装地址:http://www.wps.cn/addons/ThreadView/wdid-6424.htm
, ^. Z/ z3 z' [' l可惜的是,WPS从2012版开始不再支持插件平台,这个插件已经无法在WPS Office 2012上使用了。0 j+ H0 j* [5 Z9 h
7 @7 v9 O' k0 |: A4 o- P! t
天远ET工具箱采用的是WPS的COM接口进行开发,而非插件平台,因此在WPS Office 2012上可以运行!$ Z: D- B2 s5 w% n1 I# ?& a9 w* ~

6 s3 f0 l! B) C, B

本帖子中包含更多资源

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

已有 4 人评分威望 收起 理由
翘尾的k + 20 WPS有你更精彩!
1149737746 + 10 很给力!
zhouyiran1@126.com + 24 很给力!
松风水月 + 20 很给力!

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

热爱分享和学习。希望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粉丝团 荣誉版主奖 活跃会员奖 技术分享团 解答支持团 重阳节勋章

发表于 2013-2-27 00:11 |显示全部楼层
这是继《天远ET工具箱新功能介绍及源代码解读1——颜色定位》以来的又一力作!感谢天远的劳动和分享精神,谢谢!
回复

使用道具 举报

153

主题

109

听众

1万

积分

解答支持团长

老菜鸟

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

签到天数: 240 天

[LV.8]以坛为家I

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

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

发表于 2013-2-27 21:28 |显示全部楼层
学习了!谢谢分享!
回复

使用道具 举报

0

主题

0

听众

3

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
3
帖子
1
精华
0
发表于 2013-3-8 14:02 |显示全部楼层
哟偶哟偶哟
回复

使用道具 举报

1

主题

0

听众

298

积分

LV.4

Rank: 4

该用户从未签到

金币
5
威望
689
帖子
107
精华
0
发表于 2013-3-8 19:59 |显示全部楼层
好东西,我要学
回复

使用道具 举报

0

主题

0

听众

3

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
3
帖子
1
精华
0
发表于 2013-3-10 15:37 |显示全部楼层
好东西哦
回复

使用道具 举报

0

主题

0

听众

312

积分

LV.4

Rank: 4

该用户从未签到

金币
6
威望
838
帖子
66
精华
0
发表于 2013-8-12 00:18 |显示全部楼层
下载用用,谢谢!
回复

使用道具 举报

0

主题

0

听众

21

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
35
帖子
12
精华
0
发表于 2013-12-8 14:56 |显示全部楼层

' Z$ E0 P' O6 O  u$ T好帖子,来支持了!
回复

使用道具 举报

21

主题

36

听众

3144

积分

技术分享团员

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

签到天数: 2 天

[LV.1]初来乍到

金币
933
威望
8073
帖子
1041
精华
0

WPS粉丝团 技术分享团 技巧教程分享达人 优秀会员奖 乐于助人奖

发表于 2014-1-25 12:58 |显示全部楼层
  O% ]& Z" {+ S! J3 u1 p7 u4 z
来学习教程!支持!
回复

使用道具 举报

0

主题

0

听众

34

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
7
帖子
2
精华
0
发表于 2014-6-6 17:57 |显示全部楼层
谢谢楼主,继续支持
回复

使用道具 举报

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

快速回帖:

fastpost

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

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

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部