Excel word ppt office使用技巧大全(DOC格式)-第76部分
按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 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
文件保存为以某一单元格中的值为文件名的宏怎么写
