按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
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（）
On Error GoTo 999
Range（〃H2：H200〃） = 〃〃
For I = 1 To 99 '假設有產品編號 99 種
A = 〃0〃 & Trim（Str（I）） 'A001~A020
Range（〃B：B〃）。Select '
Cells。Find（What：=A； After：=ActiveCell； LookIn：=xlFormulas； LookAt _
：=xlPart； SearchOrder：=xlByRows； SearchDirection：=xlUp； MatchCase：= _
False）。Activate '找最後一筆
B = ActiveCell
If Cells（ActiveCell。Row； 6） = 1 Then '是否為連續 3 筆 PASS
Range（〃H65535〃）。End（xlUp）。Offset（1）。Select '找最後一筆
ActiveCell = B '免檢資料放在 H 欄
End If
Next I
999
＇A1＇。Select
End Sub
方法 3 ：
小修改；不使用公式；只使用VBA
Sub DD（）
On Error GoTo 999
Range（〃H2：H200〃） = 〃〃
For I = 1 To 99 '假设有产品编号 99 种
A = 〃0〃 & Trim（Str（I）） 'A001~A099
Range（〃B：B〃）。Select '产品编号
Cells。Find（What：=A； After：=ActiveCell； LookIn：=xlFormulas； LookAt _
：=xlPart； SearchOrder：=xlByRows； SearchDirection：=xlUp； MatchCase：= _
False）。Activate '找最后一笔
If ActiveCell。Row 》= 3 Then
B = ActiveCell
S1 = UCase（ActiveCell。Offset（0； 3）） '最后第 1 笔来货结果
S2 = UCase（ActiveCell。Offset（…1； 3）） '最后第 2 笔来货结果
S3 = UCase（ActiveCell。Offset（…2； 3）） '最后第 3 笔来货结果
N1 = ActiveCell。Offset（0； 0） '最后第 1 笔产品编号
N2 = ActiveCell。Offset（…1； 0）
N3 = ActiveCell。Offset（…2； 0）
If S1 = 〃PASS〃 And S2 = 〃PASS〃 And S3 = 〃PASS〃 And N1 = N2 And N1 = N3 Then '是否为连续
3 笔 PASS
Range（〃H65535〃）。End（xlUp）。Offset（1）。Select '找最后一笔
ActiveCell = B '免检资料放在 H 栏
End If
End If
422
…………………………………………………………Page 423……………………………………………………………
Next I
999
Range（〃A1〃）。Select
End Sub
方法 4 ：
Sub checkparts（）
'On Error Resume Next
Dim checksize As Integer
Dim samePN As Integer
Dim id As Integer
Dim acceptcount As Integer
Dim firstPN； nextPN As String
Dim vendor As String
checksize = InputBox（〃Enter the number consecutive records to check for each PN〃）
Columns（〃G：I〃）。Select
Selection。ClearContents
Range（〃B1〃）。Select
id = 1
While ActiveCell。Value 〃〃
firstPN = Trim（ActiveCell。Value）
samePN = 1
nextPN = Trim（ActiveCell。Offset（samePN； 0）。Value）
vendor = Trim（ActiveCell。Offset（0； 3）。Value）
Do While nextPN = firstPN
samePN = samePN ＋ 1
nextPN = Trim（ActiveCell。Offset（samePN； 0）。Value）
Loop
If samePN 》= checksize Then
For acceptcount = 0 To checksize 1
If UCase（Trim（ActiveCell。Offset（acceptcount； 2）。Value）） 〃ACCEPTED〃 Then Exit For
Next acceptcount
If acceptcount = checksize Then
Cells（id； 7） = id
Cells（id； 8） = firstPN
Cells（id； 9） = vendor
id = id ＋ 1
End If
End If
ActiveCell。Offset（samePN）。Select
Wend
Columns（〃G：I〃）。Select
With Selection。Font
。Name = 〃Arial〃
。Size = 9
423
…………………………………………………………Page 424……………………………………………………………
。Strikethrough = False
。Supers cript = False
。Subs cript = False
。OutlineFont = False
。Shadow = False
。Underline = xlUnderlineStyleNone
。ColorIndex = xlAutomatic
End With
With Selection
。HorizontalAlignment = xlLeft
。VerticalAlignment = xlBottom
。WrapText = False
。Orientation = 0
。AddIndent = False
。ShrinkToFit = False
。MergeCells = False
End With
Selection。Columns。AutoFit
Range（〃G1〃）。Select
ActiveWindow。SmallS