友情提示：如果本网页打开太慢或显示不完整，请尝试鼠标右键“刷新”本网页！
Excel word ppt office使用技巧大全(DOC格式)-第51部分
快捷操作: 按键盘上方向键 ← 或 → 可快速上下翻页 按键盘上的 Enter 键可回到本书目录页 按键盘上方向键 ↑ 可回到本页顶部! 如果本书没有阅读完，想下次继续接着阅读，可使用上方 "收藏到我的浏览器" 功能 和 "加入书签" 功能！
v = Int（（5 * Rnd） ＋ 1）
Cells（i； 1） = v
Next
End Sub
解答 3：是这样的：我有无数的随机数，是由 rand（）产生的，（这是以前输的，我不想
去重输这么多）这是前提。
当我获得一组合适的值的时候，我就在 A1 格内输入 1，从而使随机数固定在那组满意的
值。下一组时，我在 A1 格输入 0。就是这样。
解答 4：可不可以把满意的那组贴成数值到新表？当然是用 vba 来实现的。
Sub g（）
Sheets（1）。UsedRange。Copy
Worksheets。Add after：=Worksheets（Worksheets。Count）
Sheets（Worksheets。Count）。Cells（1； 1）。Select
Selection。PasteSpecial Paste：=xlvalues
Sheets（1）。Cells（1； 1） = 1
End Sub
解答 5：
Private Sub mandButton1_Click（）
Dim a； b As Integer
For a = 1 To 2 '产生第一次随机数
For b = 1 To 3
Cells（a； b） = Int（（8 * Rnd） ＋ 1）
405
…………………………………………………………Page 406……………………………………………………………
Next b
Next a
Dim c As Integer
For c = 1 To 10 ’询问是否对随机数满意
If （MsgBox（〃did u think the random are ok？〃； 260）） = vbYes Then
Cells（3； 1） = 1 '如果需要一个 0 或 1 的单元格给其它程序块使用
Exit Sub '满意就退出
Else '不满意就继续产生随机数
For a = 1 To 2
For b = 1 To 3
Cells（a； b） = Int（（8 * Rnd） ＋ 1）
Next b
Next a
Cells（3； 1） = 0
End If
Next c
MsgBox 〃if u want to continue rondom number press cmd1 again please〃
End Sub
解答 6 简化一下：
Sub test（）
Upper = 0
Bottom = 100
Do While Range（〃A1〃） 1
Range（〃E1〃） = Int（Rnd（） * （Upper Bottom ＋ 1）） ＋ Bottom
Response = MsgBox（〃Do you accept the number？〃； vbYesNo ＋ vbDefaultButton2）
If Response = vbYes Then Range（〃A1〃） = 1
Loop
End Sub
406
…………………………………………………………Page 407……………………………………………………………
排列组合
比如现在有一个 长度是 9 位的字符串 （ABCDEFGHI），想列出全部的只取其中 7个字符的组合值：
CDEFGHI、ADEFGHI、ABEFGHI、ABCFGHI、ABCDGHI、〃〃、共 36 个。用函数或 VBA 均可。
解答：Sub bination（）
Dim a； b； c； d； e； f； g； h； i； j； k As Integer
Dim str As String
j=1
For a = 0 To 1
For b = 0 To 2 Step 2
For c = 0 To 3 Step 3
For d = 0 To 4 Step 4
For e = 0 To 5 Step 5
For f = 0 To 6 Step 6
For g = 0 To 7 Step 7
For h = 0 To 8 Step 8
For i = 0 To 9 Step 9
k = a / 1 ＋ b / 2 ＋ c / 3 ＋ d / 4 ＋ e / 5 ＋ f / 6 ＋ g / 7 ＋ h / 8 ＋ i / 9
If k = 7 Then
str = 〃〃
If a 0 Then str = str & 〃A〃
If b 0 Then str = str & 〃B〃
If c 0 Then str = str & 〃C〃
If d 0 Then str = str & 〃D〃
If e 0 Then str = str & 〃E〃
If f 0 Then str = str & 〃F〃
If g 0 Then str = str & 〃G〃
If h 0 Then str = str & 〃H〃
If i 0 Then str = str & 〃I〃
cells（j；1）=str
j=j＋1
End If
Next i
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a
End Sub
如用 MID 函数，修改一下以上程序可得到任意长度为 9 的字符串的任取 7 个字符的组合。
解答 2：用公式的解：
407
…………………………………………………………Page 408……………………………………………………………
=REPLACE（REPLACE（M1；MIN（IF（ROW（） 4 Then
。Value = 〃〃
GoTo ex
End If
If Trim（Target） = 〃〃 Then
If Trim（。Offset（1； 0）） = 〃〃 Then
If 。Row = 5 Then
。Offset（…1； 0） = 〃〃
ElseIf 。Row 》 5 Then
。Offset（…1； 0） = 〃=SUM（〃 & 。Offset（…1； 0）。End（xlUp）。Address（False； False； xlA1） & 〃：〃
& 。Offset（…2； 0）。Address（False； False； xlA1） & 〃）〃
End If
End If
If 。Offset（1； 0）。HasFormula And 。Row = 4 Then 。Offset（1； 0） = 〃〃
If Trim（。Offset（1； 0）） 〃〃 Then
。Delete Shift：=xlUp
Cells（1； ActiveCell。Column） = Cells（1； ActiveCell。Column） 1
End If
ElseIf Trim（。Offset（1； 0）） = 〃〃 Or 。Offset（1； 0）。HasFormula Then
。Offset（1； 0） = 〃=SUM（〃 & 。End（xlUp）。Address（False； False； xlA1） & 〃：〃
& 。Address（False； False； xlA1） & 〃）〃
Cells（1； 。Column） = Cells（1； 。Column） ＋ 1
End If
End With
ex：
Application。EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange（ByVal Target As Range）
With Target
If 。Rows。Count 》 1 Or 。Columns。Count 》 1 Then ActiveCell。Select
If 。Row 《 3 And 。Column 《 5 Then Cells（4； ActiveCell。Column）。Select
408
…………………………………………………………Page 409……………………………………………………………
End With
End Sub
以上代码是按我理想的做的。
主要部分：
If Trim（。Offset（1； 0）） = 〃〃 Or 。Offset（1； 0）。HasFormula Then
。Offset（1； 0） = 〃=SUM（〃 & 。End（xlUp）。Address（False； False； xlA1） & 〃：〃
& 。Address（False； False； xlA1） & 〃）〃
Cells（1； 。Column） = Cells（1； 。Column） ＋ 1
End If
没有注释，将就看吧！
dick 小修改。。。
Private Sub Worksheet_Change（ByVal Target As Range）
Application。EnableEvents = False '触发设 False
R = Target。Row
C = Target。Column
A = Range（〃A65536〃）。End（xlUp）。Offset（0）。Row '最后一笔
If C = 1 Then '最后一笔
If R = A Then
ALL = Application。WorksheetFunction。Sum（Range（Cells（1； 1）； Cells（R； 1））） 'sum
Target。Offset（1） = ALL '最后一笔＋1；放 sum 值
Else
ALL = Application。WorksheetFunction。Sum（Range（Cells（1； 1）； Cells（A 1； 1））） 'sum
Cells（A； 1） = ALL '更动；重新计算
End If
End If
Application。EnableEvents = True ''触发设 True
End Sub
更正
If C = 1 Then 'A 栏
If R = A Then '最后一笔
tof
翻阅了一些书；知道 VBA 向单元格输入公式是以文本格式输入的。
受到启发只要使用 RC 形式；将移动数字作为变量； 连接文本输入就可以达到目的了；
现使用循环激活达到〃〃的单元格的行
I2 = 2
LINE3：
If Cells（I2； h） = 〃〃 Then
Else
I2 = I2 ＋ 1
GoTo LINE3：
End If
Cells（I2； h ＋ 1）。Formula = 〃=SUM（R＇〃 & I2 & 〃＇C：R＇…1＇C）〃
409
…………………………………………………………Page 410……………………………………………………………
关于使用 VBA 复制的问题
问题：我有一个表格，如何将其原封不动的在同一表单如 SHEET1 中复制多份，要求它们完全一
样。我用宏录制完后，总是对最后选定的单元格进行修改，很不方便。
如 A1：C6 是一个小表，我在 A7 位置按快捷键生成一张，到 A15 按快捷键又生成一张，而不必
在宏中将 A7 改为 A15。
解答： ACCESS
建立下面宏时，先建立一快捷键
Sub cy（）
Sheets（〃sheet1〃）。Range（〃A1：C6〃）。Copy
ActiveSheet。Paste
Range（〃A1〃）。Select
End Sub
解答 2：这种方法单元格被锁定，不能实际任意位置的的粘贴，好像不行！ ACCESS
Sub cy（）
Sheets（〃sheet1〃）。select
ActiveSheet。Unprotect
Range（〃A1：C6〃）。Copy
ActiveSheet。Paste
ActiveSheet。Protect
Range（〃A1〃）。Select
End Sub
解答 4dick：工作页名称上方按右键》》检视程序代码》》程序 COPY 贴上
任何单元格快按 2 下；即 COPY 完成
****************************
Private Sub Worksheet_BeforeDoubleClick（ByVal Target As Range； Cancel As Boolean）
R = Target。Row
C = Target。Column
Range（〃A1：C4〃）。Select
Selection。Copy
Cells（R； C）。Select
ActiveSheet。Paste
End Sub
解答 5Rowen：'在 DICK 代码基础上的改进
Private Sub Worksheet_BeforeDoubleClick（ByVal Target As Range； Cancel As Boolean）
R = Target。Row
C = Target。Column
＇A1：C4＇。Copy （Cells（R； C））
End Sub
文件保存为以某一单元格中的值为文件名的宏怎么写
用命令： ActiveWorkbook。SaveCopyAs Str（Range（〃Sheet1！A1〃）） ＋ 〃。xls〃
410
…………………………………………………………Page 411……………………………………………………………
自动处理某种格式
Q： 请问有什么方法可以把相关列的内容自动形成一种格式？如：
日期 商品 金额/1…1 A材料 50 /1…1 B材料 40 /1…2 C 材料 70/1…2 A 材料 34/1…3 C 材料 99 。
上述的表格中，“商品”与“金额”是相关系的，请问有什么方法，使当商品是 A 材料时、它
自动填充上蓝色和成为白色字，“金额”字段也自动作相应的填充上蓝色和是白色字？
即：
A B C
1 日期 商品 金额 /2 1…1 A 材料 50 （蓝底、白字）/3 1…1 B 材料 40 /4 1…2 C 材料 70 （黄
底、红字） /5 1…2 A 材料 34 （蓝底、白字） /6 1…3 C 材料 99 （黄底、红字） /使用“条
件格式”做不到，如用“排序”方法先选出再填充颜色等又会影响其它字段的计算，因而请教
各位是否有什么方法（例如宏）等可设定自动处理上述问题？先谢谢。
A： wildgoose
我可以提供一份变通的办法：你可以插入三列，一列用来用来存放你的材料名称，一列放 1、
2、3。。。数字，然后在第三列中用 vlookup 函数取出对应材料名称的数字。后使用 条件格式 ，
通过判断 1、2、3。。。 就可以了
A：dick
Private Sub Worksheet_Change（ByVal Target As Range）
X = ActiveCell。Row（） ' 目前位置
Y = ActiveCell。Column（）
L = ＇b65535＇。End（xlUp）。Row（） '计算共有几笔
For I = 0 To L 2
A = ＇b65535＇。End（xlUp）。Offset（…I； 0） '
Select Case A
Case 〃A 材料〃
＇b65535＇。End（xlUp）。Offset（…I； 0）。Select 'B
Selection。Font。ColorIndex = 2
Selection。Interior。ColorIndex = 5
＇b65535＇。End（xlUp）。Offset（…I； 1）。Select 'A
Selection。Font。ColorIndex = 2
Selection。Interior。ColorIndex = 5
＇b65535＇。End（xlUp）。Offset（…I； …1）。Select 'C
Selection。Font。ColorIndex = 2
Selection。Interior。ColorIndex = 5
Case 〃B 材料〃
Case 〃C 材料〃
＇b65535＇。End（xlUp）。Offset（…I； 0）。Select
Selection。Font。ColorIndex = 3
Selection。Interior。ColorIndex = 6
＇b65535＇。End（xlUp）。Offset（…I； 1）。Select
Selection。Font。ColorIndex = 3
Selection。Interior。ColorIndex = 6
411
…………………………………………………………Page 412……………………………………………………………
＇b65535＇。End（xlUp）。Offset（…I； …1）。Select
Selection。Font。ColorIndex = 3
Selection。Interior。ColorIndex = 6
End Select
Next I
Cells（X； Y）。Select '动作前单元格
End Sub
A：Rowen
选中 B2…》格式…》条件格式…》公式…》=（LEFT（B2；1）=〃A〃）…》设定字体及图案。添加公式…》类
推。。。用格式刷填充到所需单元格。条件格式最多可设定三个；多过请用 VBA 实现
在 VBA 的FRM 窗口右上方的“X”如果去掉
Q：问题一：关于加密窗口的问题！上次请教了一个关闭 EXCEL 函数的问题！现在又发现一个问
题：即在 VBA 的FRM 窗口右上方的“X”如果去掉？因为它关闭了我的加密窗口就不起作用？
或者如果按“X”的时候，自动关闭EXCEL 就行，如何？多谢！
问题二，我每次经过加密窗口后进入工作表，总是被隐藏了，用什么函数把隐藏的自动打开？
这样我的可以写一个宏！OK！
A： tof
Private Sub UserForm_QueryClose（Cancel As Integer； CloseMode As Integer）
If CloseMode 1 Then Cancel = 1
UserForm1。Caption = 〃The Close box won't work！ Click me！〃
End Sub
dick
Sub dd（）
For i = 1 To Worksheets。Count
Sheets（i）。Visible = True
Next i
End Sub
vba for excel 程序纠错
Q：我想对所有工作表进行将公式转为数值，录制宏后加上了几句但结果不对，请斧正！
sub aa（）
dim sht as worksheet
For Each sht In Worksheets
ActiveSheet。Range（〃A1：C4〃）。Select
Selection。Copy
Selection。PasteSpecial Paste：=xlValues； Operation：=xlNone； SkipBlanks：= _
False； Transpose：=False
ActiveSheet。Paste
Application。CutCopyMode = False
Next
412
…………………………………………………………Page 413……………………………………………………………
End Sub
A： roof
试试在 for。。。each。。。和 activesheet。。。之间加上一句“sht。activate〃。结果如下：
sub aa（）
dim sht as worksheet
For Each sht In Worksheets
sht。activate
ActiveSheet。Range（〃A1：C4〃）。Select
Selection。Copy
Selection。PasteSpecial Paste：=xlValues； Operation：=xlNone； SkipBlanks：= _
False； Transpose：=False
ActiveSheet。Paste
Application。CutCopyMode = False
Next
End Sub
excelhelp：其实录制得来的宏（macro）程序可以自行修改，以达到高效率、精简的目的。你
的程序这样改会较容易看得懂，记着，Selection 一般可以省去，使程序一气呵成，也可以避
免现存储存格（activecell，浮标所在地）给移动。
Sub aa（）
Dim Sht As Worksheet
For Each Sht In Worksheets
With Sht。Range（〃A1：C4〃
快捷操作: 按键盘上方向键 ← 或 → 可快速上下翻页 按键盘上的 Enter 键可回到本书目录页 按键盘上方向键 ↑ 可回到本页顶部!
温馨提示： 温看小说的同时发表评论，说出自己的看法和其它小伙伴们分享也不错哦！发表书评还可以获得积分和经验奖励，认真写原创书评 被采纳为精评可以获得大量金币、积分和经验奖励哦！