按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
***************************
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。SmallScroll ToRight：=2
End Sub
如何用不同颜色的字体，将手式输入与公式计算结果区分开来
解答 1：可以用条件格式，如 A1 格，则条件格式公式如下： =CELL（〃contents〃；A1）
解答 2 ：用自定义函数了：
Function IsFormula（cl）
adrs = cl。Address
If Left（Range（adrs）。Formula； 1） = 〃=〃 Then
IsFormula = True
Else
IsFormula = False
End If
End Function
条件格式公式为：
=IsFormula（A1）
怎样在电话号码书中提取手机号码
解答：假设 a1=3322211；a2=13322121122；a3=2503225
a4=｛=sum（（len（a1：a3）=11）*（a1：a3））｝
完善：建议再加一个第一位是〃1〃的判断条件； 以免长途超过 11 位的情况
｛=SUM（（LEN（A1：A3）=11）*（A1：A3）*（LEFT（A1：A3；1）=〃1〃））｝
424
…………………………………………………………Page 425……………………………………………………………
是不是用数组函数解决？请教各位
a1=aa； b1=apple
a2=bb；b2=orange
。。。。。
if（a11=aa； 则 b11=apple
if（a11=bb； 则 b11=orange
。。。。。。
是不是用数组函数解决？请教各位。
解答：
如果对应关系比较多，先在一个工作表中分两列输入查找值及查找结果，如在工作表 SHEET2
中的A 列输入查找值，B 列输入对应的结果，在另一个工作表的 B1 格中用公式
=VLOOKUP（A1；SHEET2！A：B；2；0）
即可按该表的A1 格中的值，在 sheet2 表的 A 列中查找并返回对应 B 列的值。
如果对应关系不多，可用公式
=VLOOKUP（A1；｛〃aa〃；〃apple〃；〃bb〃；〃orange〃；。。。。。。｝；2；0）
注意其中的；号。
又问：在 SHEET1 ！B2 输入
=IF（A1=〃〃；〃〃；if（没有匹配；〃这是新货号〃；vlookup（a1；sheet2！a：b；2；0）））
如何实现上面要求。（没有匹配；〃这是新货号〃；）
解答：ISNA（VLOOKUP（。。。。））
关于日期的格式化问题
我要接收汇总数据；出生年月有的写成“58。5 ”有的写成〃58。05〃 我现在需要统一为 1958。05（常
规型）怎样实现。
解答：
=value（IF（LE