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