按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
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（〃S