Excel word ppt office使用技巧大全(DOC格式)-第78部分
按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
。Caption = 〃查阅资料 （&C）〃
。OnAction = 〃pickup〃
End With
请教如何准确取值
a1 格 东：ww34…99 生产 ，a2 格 西：123…fd…12 设计开发 ，a3 格 南：88…77 负责销售
以上是三个单元格的内容，现在我想将产品代码单独取出放到b1；b2；b3 中，不知如何处理（用
vba ），请指点，谢谢！规律是冒号以后，文字以前的，如上面的 ww34…99；123…fd…12；88…77；如
何将他们分别取出？
解答：1 以 A1：A10 为例：
Sub test（）
Dim rng As Range
Dim tmp As Integer
For Each rng In Range（〃A1：A10〃）
tmp = InStr（1； rng。Text； 〃：〃）
rng。Offset（0； 1） = IIf（tmp 》 0； Mid（rng。Text； tmp ＋ 1）； 〃〃）
Next
416
…………………………………………………………Page 417……………………………………………………………
End Sub
解答 2 ：Sub test（）
Dim i As Integer
Dim tmp As Integer
Dim i As Range
For Each rng In Range（〃A1：A10〃）
If rng = 〃〃 Then Exit Sub
tmp = InStr（1； rng。Text； 〃：〃）
For i = （tmp ＋ 1） To Len（rng）
If Asc（Mid（rng； i； 1）） 》 0 And Asc（Mid（rng； i； 1）） 《 132 Then
rng。Offset（0； 1） = rng。Offset（0； 1） & Mid（rng； i； 1）
End If
Next
Next
End Sub
（注：正确应该是 122，只不过中文字不会小于 132 故也没出错。字符如下：
0～9 48～57
小写 a～z 97～122
大写 A～Z 65～90
例： ASC（A）=65）
如何在单元格中显示文件创建的日期
答：下例显示 C： 中部分文件的创建日期； 涉及文件属性及其它； 请参阅 FileSystemObject
对象
Sub ShowFileList（）
Dim fs； f； f1； fc； folderspec
folderspec = 〃C：”
Set fs = CreateObject（〃s cripting。FileSystemObject〃）
Set f = fs。GetFolder（folderspec）
Set fc = f。Files
For Each f1 In fc
Debug。Print f1。Name； f1。DateCreated
Next
End Sub
根据系统时间判断是否执行某宏
解答：本范例设定 my_Procedure 这个宏在下午 5 点开始执行。
Application。OnTime TimeValue（〃17：00：00〃）； 〃my_Procedure〃
见 ontime 之 help 范例
解答 2：本示例设置 15 秒后运行 my_Procedure 过程，从现在开始计时。
Application。OnTime Now ＋ TimeValue（〃00：00：15〃）； 〃my_Procedure〃
417
…………………………………………………………Page 418……………………………………………………………
删除当前活动工作簿
Sub 删除当前工作簿（）
'
Dim x； y； z
x = ActiveWorkbook。FullName
z = ActiveWorkbook。Path
If z = 〃〃 Then
y = MsgBox（〃确实彻底删除当前工作簿吗？〃； vbYesNo）
If y = vbNo Then Exit Sub
If y = vbYes Then ActiveWorkbook。Close savechanges：=False
End If
If z 〃〃 Then
y = MsgBox（〃确实彻底删除当前工作簿吗？〃； vbYesNo）
If y = vbNo Then Exit Sub
If y = vbYes Then
ActiveWorkbook。Close savechanges：=False
Kill x
End If
End If
End Sub
如何以工作簿中的一个 SHEET 是否激活为判断条件
解答 1：If ActiveSheet。Name = 〃Operation〃 Then
MsgBox 〃It's Ok〃
Else
MsgBox 〃It's fault〃
End If
解答 2 ：分别建：
Private Sub Worksheet_Activate（）
MsgBox 〃It's Ok〃
End Sub
Private Sub Worksheet_Deactivate（）
MsgBox 〃It's fault〃
End Sub
教各位关于按钮位置的问题
本人设计了一个按钮，设计在 A12 上，现在我要在 A13 上加上数据后，如何让按钮的位置自
动下移下一行？
解答：Private Sub Worksheet_SelectionChange（ByVal Target As Range）
mandButton1。Top = Range（Cells（1； 1）； Cells（ActiveCell。Row； 1））。Rows。Height＋15
418
…………………………………………………………Page 419……………………………………………………………
End Sub
一个用 VBA 写入公式的问题
有一个这样的问题 ：统计进度以每天的日期做为文件名，如今天是2002 年 9 月 23 日，文件
名就是 2002 年 9 月 23 日。xls 工作完成后用它另存为 2002 年 9 月 24 日。xls 明天使用2002 年
9 月 24 日。xls 文件。
有一个问题 如今天是 23 日今要在a9 单元格中引用昨天 2002 年 9 月 22 日。xls 中的一个数据
公式= ＇2002 年9 月22 日。XLS＇sheet1！a10＋a7/1000 也就是昨天的一个数字加上今天的一个数据
除以 1000 每天改公式烦死了 能不能做一个 auto_open 宏
＇2002 年 9 月 22 日。XLS＇sheet1！a10＋a9/1000
红字这段自动变成 today…1 也就是昨天的日期，
我试了好几次没有成功 请 vba 高手指点
解答：
时间原因，做得很简单，你可以自己加一点 Error 语句，在运行宏之前检查昨天的文件是否存
在等等，建议不要放在 auto_open（）里，如果要必须放，要加语句检查一下宏运行的次数，不
可重复运行。以下语句在 Excel XP 中通过检测。
Sub auto_open（）
Dim dataToday； dateLastday As String
dateToday = CStr（Date）
dateLastday = CStr（Date 1）
ChDir 〃C：”
Workbooks。Add
ActiveWorkbook。SaveAs Filename：=dateToday
Cells（9； 1）。Select
ActiveCell。FormulaR1C1 = 〃='＇〃 & dateLastday & 〃。xls＇Sheet1'！R9C1＋'＇〃 & dateLastday
& 〃。xls＇Sheet1'！R10C1/1000〃
End Sub
又问：如果日期后面还有文字怎么办？
答：dateToday=CStr（Date） & 〃（你要加的文字尽管放）〃
怎么能在 excel 没打开文件的时候被禁用
如何能让一个宏命令按钮在无文件打开状态下被禁用？
解答：例如这个按钮在 Standard 工具列，名字叫 GO（&C），做法如下：
在 personal 增加一个 class
Public WithEvents App As Application
Private Sub App_WorkbookActivate（ByVal Wb As Workbook）
Application。mandBars（〃Standard〃）。Controls（〃GO（&C）〃）。Enabled = True
End Sub
Private Sub App_WorkbookDeactivate（ByVal Wb As Workbook）
Application。mandBars（〃Standard〃）。Controls（〃GO（&C）〃）。Enabled = False
419
…………………………………………………………Page 420……………………………………………………………
End Sub
再到 personal 任何 1 个 Module
Public z As New Class1
Sub lnitialzeApp（）
Set z。App = Application
End Sub
在已有数值的单元格中再增加或减去另一个数
Sub MyMicro（ ）
OldValue = Val （ActiveCell。Value ）
InputValue = InputBox （ “输入数值，负数前输入减号”； “小小计算器”）
ActiveCell。Value = Val （OldValue ＋ InputValue）
End Sub
问：此宏一次只能输入一个数值，如何才能一次输入多个数值（如：1＋2＋3。。。），另外，能否进
行乖除运算？
答：Inputvalue1=。。。。。
Inputvalue2=。。。。。
Inputvalue3=。。。。。
。。。。。。
ActiveCell。Value = Val （OldValue ＋ InputValue1＋Inputvalue2＋Inputvalue3。。。）
乘或除把里面的‘＋ ’换成‘*’或‘/ ’即可
对 excel 里录入的数据进行关系验证
比如：A1 、A2 、A3 这 3 个单元格，已经输入了 3 个数字，
现在需要验证这 3 个已经输入的数据是否满足 A1=A2＋A3 的
关系，应该如何设置呢？
我的方法是：在一个新的单元格中输入以下公式：＝if（a1=a2＋a3；true；false）；如果 a1=a2＋a3；该单
元格的值为 true；否则为 false 。但是这种做法会占用到该工作表的空间，而该工作表已经非常
大了（有 1000 多行，要满足各种各样公式关系的很多），我希望能够做到跳出一个窗口告诉我
哪些单元格不符合公式关系，相当于审核工作表的功能。
解答：本例是依据竖向记录检验的。运行时将 x 替换成记录行数。
Sub pd（）
Dim cw（1000） As Integer
For i = 1 To x '…………x 为记录行数
If Sheet1。Cells（i； 3） Sheet1。Cells（i； 1） ＋ Sheet1。Cells（i； 2） Then
j = j ＋ 1
cw（j） = i
End If
Next i
Sheets（1）。Select
For i = 1 To j
For k = 1 To 3
420
…………………………………………………………Page 421……………………………………………………………
Sheet1。Cells（cw（i）； k）。Select
Selection。Font。Bold = True
Selection。Interior。ColorIndex = 35
Selection。Font。ColorIndex = 3
Next k
Next i
Sheets（2）。Select
Sheets（2）。Cells（1； 1） = 〃数据数值输入错误有〃 & j & 〃处〃
For i = 1 To j
Sheets（2）。Cells（i ＋ 1； 1） = 〃数据数值输入有误！！！（第〃 & cw（i） & 〃行）〃
Next i
End Sub
如何自动跳过有公式的单元格继续输入
可以使用 Change 事件完成
Private Sub Worksheet_Change（ByVal Target As Range）
If Target。Row 《 11 And Target。Column 《 3 Then
If Target。Column = 1 Then
Target。Offset（0； 1）。Select
ElseIf Target。Column = 2 Then
Target。Offset（1； …1）。Select
Else
Exit Sub
End If
End If
End Sub
查询设计“最近”“连续”“三次”〃Pass〃
Q：字段名 5 个或更多，记录有近 8000 条。
ID 产品编号 订单编号 供应商名称 来货结果
1 A001 0001 3M Fail /2 A001 0002 3M Fail /3 A001 0003 3M Pass/4 A001 0004 3M Pass /5 A001
0005 3M Pass /6 A002 0006 JVC Pass /7 A002 0007 JVC Pass /8 A002 0008 JVC Pass /9 A002
0009 JVC Pass /〃〃〃〃按照公司进货处理，如果某一产品“最近”“连续”“三次”〃Pass〃则
此产品以后之来货可以“免检”。订单编号由过去至现在为 0001~0013 至更大；则上例中， 请
问，如何设计查询？
A： 方法 1：
用公式分类排序（闻鸥学堂里有），只排出每类前三个，判断是否都是“Pass ”，然后。。。。会
了？
方法：
1。 在 F4 输入公式
=IF（AND（B4=B3；B4=B2；E4=〃pass〃；E3=〃pass〃；E2=〃pass〃）；1；0）
2。 在 F4 单元格右下角快按 2 下（填满公式）
3。 将下列程序 COPY 至 VBA 中；再做个按钮（更新） 即可
421
…………………………………………………………Page 422……………………………………………………………
***************************
Sub DD（）
