Excel宏技巧II.docx
《Excel宏技巧II.docx》由会员分享，可在线阅读，更多相关《Excel宏技巧II.docx（35页珍藏版）》请在冰豆网上搜索。
Excel宏技巧II
Excel宏技巧II
自动隐藏表格中无数据的行
表1 是数据源，经常改变；
表2 引用表1 中某列有数据的单元格（利用动态位址已实现。
）
由于表1 的改变，表2 的大小随之而变。
问题：
如何实现表2 中没有数据的行（有公式）自动隐藏？
谢谢赐教！
Sub abc（）
For i = 1 To 300
If Cells（i, 1）.value = "" Then Rows（i）.Hidden = True
Next i
End Sub
你写的语句可以解决隐藏的问题，可是如果我执行了它之后，再在表1中增加数据，表2不会自动显示有了数据的行。
如何修改？
将此宏设为自动运行（打开文件时）
Sub abc（）
For i = 1 To 300
If Cells（i, 1）.value <>"" Then Rows（i）.Hidden = false
Next i
End Sub
用VBA如何自动合并列的内容？
Sub MergeTest（）
For i = 3 To 30
Cells（i, 3） = Cells（i, 1） & Chr（10） & Cells（i, 2）
Next
End Sub
基于VB和EXCEL的报表设计及打印
在现代管理信息系统的开发中，经常涉及到数据信息的分析、加工，
最终还需把统计结果形成各种形式的报表提供给领导决策参考，或进行外
部交流。
在Visual Basic中制作报表，通常是用数据环境设计器（Data
Environment Designer）与数据报表设计器（Data Report Designer）,或者
使用第三方产品来完成。
但对于大多数习惯于Excel报表的用户而言,用以
上方法生成的报表在格式和功能等方面往往不能满足他们的要求。
由于Excel具有自己的对象库，在Visual Basic工程中可以加以引用，
通过对Excel使用OLE自动化，可以创建一些外观整洁的报表，然后打印输
出。
这样实现了Visual Basic应用程序对Excel的控制。
本文将针对一个具
体实例，阐述基于VB和EXCEL的报表设计及打印过程。
1）创建Excel对象
Excel对象模型包括了128个不同的对象，从矩形、文本框等简单的对
象到透视表，图表等复杂的对象。
下面简单介绍一下其中最重要，也是用
得最多的五个对象。
（1）Application对象
Application对象处于Excel对象层次结构的顶层，表示 Excel自身的
运行环境。
（2）Workbook对象
Workbook对象直接地处于Application对象的下层，表示一个Excel工
作簿文件。
（3）Worksheet对象
Worksheet对象包含于Workbook对象，表示一个Excel工作表。
（4）Range对象
Range对象包含于Worksheet对象，表示 Excel工作表中的一个或多个
单元格。
（5）Cells对象
Cells对象包含于Worksheet对象，表示Excel工作表中的一个单元格。
如果要启动一个Excel，使用Workbook和Worksheet对象，下面的代码
启动了Excel并创建了一个新的包含一个工作表的工作薄：
Dim zsbexcel As Excel.Application
Set zsbexcel = New Excel.Application
zsbexcel.Visible = True
如要Excel不可见，可使zsbexcel.Visible = False
zsbexcel.SheetsInNewWorkbook = 1
Set zsbworkbook = zsbexcel.Workbooks.Add
2）设置单元格和区域值
要设置一张工作表中每个单元格的值，可以使用Worksheet对象的
Range属性或Cells属性。
With zsbexcel.ActiveSheet
.Cells（1, 2）.value = "100"
.Cells（2, 2）.value = "200"
.Cells（3, 2）.value = "=SUM（B1:
B2）"
.Range（"A3:
A9"） = "中国人民解放军"
End With
要设置单元格或区域的字体、边框，可以利用Range对象或Cells对象
的Borders属性和Font属性：
With objexcel.ActiveSheet.Range（"A2:
K9"）.Borders '边框设置
.LineStyle = xlBorderLineStyleContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With objexcel.ActiveSheet.Range（"A3:
K9"）.Font '字体设置
.Size = 14
.Bold = True
.Italic = True
.ColorIndex = 3
End With
通过对Excel单元格和区域值的各种设置的深入了解,可以创建各种复
杂、美观、满足需要的、具有自己特点的报表。
3）预览及打印
生成所需要的工作表后，就可以对EXCEL发出预览、打印指令了。
zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait '
设置打印方向
zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4 '
设置打印纸的打下
zsbexcel.Caption = "打印预览" '设置预览窗口的
标题
zsbexcel.ActiveSheet.PrintPreview '打印预览
zsbexcel.ActiveSheet.PrintOut '打印输出
通过打印方向、打印纸张大小的设置，不断进行预览，直到满意为止，
最终进行打印输出。
为了在退出应用程序后EXCEL不提示用户是否保存已修改的文件,需使
用如下语句：
zsbexcel.DisplayAlerts = False
zsbexcel.Quit '退出EXCEL
zsbexcel.DisplayAlerts = True
如此设计的报表打印是通过 EXCEL程序来后台实现的。
对于使用者来
说，根本看不到具体过程，只看到一张张漂亮的报表轻易地被打印出来了。
4）具体实例
下面给出一个具体实例，它在window98、Visual Basic 6.0、
Microsoft Office97的环境下调试通过。
在VB中启动一个新的Standard EXE工程，在“工程”菜单的“引用”
选项下引用Excel Object Library；然后在Form中添加一个命令按钮
cmdExcel；最后在窗体中输入如下代码：
Dim zsbexcel As Excel.Application
Private Sub cmdExcel_Click（）
Set zsbexcel = New Excel.Application
zsbexcel.Visible = True
zsbexcel.SheetsInNewWorkbook = 1
Set zsbworkbook = zsbexcel.Workbooks.Add
With zsbexcel.ActiveSheet.Range（"A2:
C9"）.Borders '边框设置
.LineStyle = xlBorderLineStyleContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With zsbexcel.ActiveSheet.Range（"A3:
C9"）.Font '字体设置
.Size = 14
.Bold = True
.Italic = True
.ColorIndex = 3
End With
zsbexcel.ActiveSheet.Rows.HorizontalAlignment =
xlVAlignCenter '水平居中
zsbexcel.ActiveSheet.Rows.VerticalAlignment =
xlVAlignCenter '垂直居中
With zsbexcel.ActiveSheet
.Cells（1, 2）.value = "100"
.Cells（2, 2）.value = "200"
.Cells（3, 2）.value = "=SUM（B1:
B2）"
.Cells（1, 3）.value = "中国人民解放军"
.Range（"A3:
A9"） = "50"
End With
zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait '
xlLandscape
zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
zsbexcel.ActiveSheet.PrintOut
zsbexcel.DisplayAlerts = False
zsbexcel.Quit
zsbexcel.DisplayAlerts = True
Set zsbexcel = Nothing
提高EXCEL中VBA的效率
方法1：
尽量使用VBA原有的属性、方法和Worksheet函数
由于Excel对象多达百多个，对象的属性、方法、事件多不胜数，对于初学者来说可能对它们不全部了解，这就产生了编程者经常编写与Excel对象的属性、方法相同功能的VBA代码段，而这些代码段的运行效率显然与Excel对象的属性、方法完成任务的速度相差甚大。
例如用Range的属性CurrentRegion来返回 Range 对象，该对象代表当前区。
（当前区指以任意空白行及空白列的组合为边界的区域）。
同样功能的VBA代码需数十行。
因此编程前应尽可能多地了解Excel对象的属性、方法。
充分利用Worksheet函数是提高程序运行速度的极度有效的方法。
如求平均工资的例子：
For Each c In Worksheet
（1）.Range（″A1:
A1000″）
Totalvalue = Totalvalue ＋ c.value
Next
Averagevalue = Totalvalue / Worksheet
（1）.Range（″A1:
A1000″）.Rows.Count
而下面代码程序比上面例子快得多：
Averagevalue=Application.WorksheetFunction.Average（Worksheets
（1）.Range（″A1:
A1000″））
其它函数如Count,Counta,Countif,Match,Lookup等等，都能代替相同功能的VBA程序代码，提高程序的运行速度。
方法2：
尽量减少使用对象引用，尤其在循环中
每一个Excel对象的属性、方法的调用都需要通过OLE接口的一个或多个调用，这些OLE调用都是需要时间的，减少使用对象引用能加快VBA代码的运行。
例如
1．使用With语句。
Workbooks
（1）.Sheets
（1）.Range（″A1:
A1000″）.Font.Name=″Pay″
Workbooks
（1）.Sheets
（1）.Range（″A1:
A1000″）.Font.FontStyle=″Bold″ ...
则以下语句比上面的快
With Workbooks
（1）.Sheets
（1）.Range（″A1:
A1000″）.Font
.Name = ″Pay″
.FontStyle = ″Bold″
...
End With
2．使用对象变量。
如果你发现一个对象引用被多次使用，则你可以将此对象用Set 设置为对象变量，以减少对对象的访问。
如：
Workbooks
（1）.Sheets
（1）.Range（″A1″）.value = 100
Workbooks
（1）.Sheets
（1）.Range（″A2″）.value = 200
则以下代码比上面的要快：
Set MySheet = Workbooks
（1）.Sheets
（1）
MySheet.Range（″A1″）.value = 100
MySheet.Range（″A2″）.value = 200
3．在循环中要尽量减少对象的访问。
For k = 1 To 1000
Sheets（″Sheet1″）.Select
Cells（k,1）.value = Cells（1,1）.value
Next k
则以下代码比上面的要快：
Set Thevalue = Cells（1,1）.value
Sheets（″Sheet1″）.Select
For k = 1 To 1000
Cells（k,1）.value = Thevalue
Next k
方法3：
减少对象的激活和选择
如果你的通过录制宏来学习VBA的，则你的VBA程序里一定充满了对象的激活和选择，例如Workbooks（XXX）.Activate、Sheets（XXX）.Select、Range（XXX）.Select等,但事实上大多数情况下这些操作不是必需的。
例如
Sheets（″Sheet3″）.Select
Range（″A1″）.value = 100
Range（″A2″）.value = 200
可改为：
With Sheets（″Sheet3″）
.Range（″A1″）.value = 100
.Range（″A2″）.value = 200
End With
方法4：
关闭屏幕更新
如果你的VBA程序前面三条做得比较差，则关闭屏幕更新是提高VBA程序运行速度的最有效的方法，缩短运行时间2/3左右。
关闭屏幕更新的方法：
Application.ScreenUpdate = False
请不要忘记VBA程序运行结束时再将该值设回来：
Application.ScreenUpdate = True
以上是提高VBA运行效率的比较有效的几种方法
本示例重复最近用户界面命令。
本示例必须放在宏的第一行。
Application.Repeat
下例中，变量 counter 代替了行号。
此过程将在单元格区域 C1:
C20 中循环，将所有绝对值小于 0.01 的数字都设置为 0（零）。
Sub RoundToZero1（）
For Counter = 1 To 20
Set curCell = Worksheets（"Sheet1"）.Cells（Counter, 3）
If Abs（curCell.Value） < 0.01 Then curCell.Value = 0
Next Counter
End Sub
述过程在单元格区域 A1:
D10 中循环，将所有绝对值小于 0.01 的数字都设置为 0（零）。
Sub RoundToZero2（）
For Each c In Worksheets（"Sheet1"）.Range（"A1:
D10"）.Cells
If Abs（c.Value） < 0.01 Then c.Value = 0
Next
End Sub
下述过程在工作表上运行时，将在活动单元格周围的区域内循环，将所有绝对值小于 0.01 的数字都设置为 0（零）。
Sub RoundToZero3（）
For Each c In ActiveCell.CurrentRegion.Cells
If Abs（c.Value） < 0.01 Then c.Value = 0
Next
End Sub
下述过程在工作的空行写入数据
Sub 输入（）
x = 3 '从第3行开始
Do While Not （IsEmpty（Cells（x, 2）.Value）） '判断第2列的最后一行（即空行的上一行）
x = x + 1 '在最后一行加一行即为空行
Loop
'以下为写入数据
Cells（x, 1） = Sheets（"sheet1"）.Cells（1, 3）
Cells（x, 2） = Sheets（"sheet1"）.Cells（2, 3）
Cells（x, 3） = Sheets（"sheet1"）.Cells（3, 3）
Cells（x, 4） = Sheets（"sheet1"）.Cells（4, 3）
Sheets（"sheet1"）.Select
Cells（2, 3） = Cells（2, 3） + 1 '每写一行自动加入序列号
Sheets（"sheet2"）.Select
End Sub
Sub 每日结帐（）
' 录入发生额 Macro
' 30 记录的宏 2002-12-18
Application.ScreenUpdating = False '关闭屏幕显示
If Application.InputBox（"请输入密码：
"） = 1234 Then '此行与倒数3-5行设置密码
Dim Msg, Style, Title, X, MyString '设置变量
Msg = "！
！
！
结帐后不能恢复，结帐吗？
" ' 定义信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定义按钮。
Title = "本日结帐！
" ' 定义标题。
X = MsgBox（Msg, Style, Title）
If X = vbYes Then ' 用户按下“是”。
Close
Call 备份
Call 重算所有表
Sheets（"日报表"）.Select
ActiveSheet.Unprotect
Selection.AutoFilter Field:
=1 '全部显示
Sheets（"余额表"）.Select
ActiveSheet.Unprotect
Selection.AutoFilter Field:
=1 '全部显示
Range（"e6:
g183,i6:
k183"）.Copy
Sheets（"日报表"）.Select
Range（"n6"）.Select
Selection.PasteSpecial Paste:
=xlPasteValuesAndNumberFormats, Operation:
= _
xlNone, SkipBlanks:
=False, Transpose:
=False
ActiveSheet.Protect DrawingObjects:
=True, Contents:
=True, Scenarios:
=True _
, AllowSorting:
=True, AllowFiltering:
=True
[A2].Copy
Sheets（"银行帐"）.Select
Range（"F2"）.Select
Selection.PasteSpecial Paste:
=xlPasteValues, Operation:
=xlNone, SkipBlanks _
:
=False, Transpose:
=False
ActiveSheet.Protect DrawingObjects:
=True, Contents:
=True, Scenarios:
=True _
, AllowSorting:
=True, AllowFiltering:
=True
Application.CutCopyMode = False
End If
Else:
MsgBox "密码错误，即将退出！
" '此行与第2行共同设置密码
End If
Application.ScreenUpdating = True '打开屏幕显示
End Sub
Sub 月末结帐（）
Application.ScreenUpdating = False
If Application.InputBox（"请输入密码：
"） = 1234 Then '此行与倒数3-5行设置密码
'以下三行为消息框
Dim Msg, Style, Title, X, MyString
Msg = "！
！
！
结帐后不能恢复，结帐吗？
" ' 定义信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定义按钮。
Title = "月末结帐！
" ' 定义标题。
X = MsgBox（Msg, Style, Title）
If X = vbYes Then ' 用户按下“是”。
Close
Call 备份
Call 重算所有表
Sheets（"余额表"）.Select
[L6:
L183].Copy
Sheets（"日报表"）.Select
Range（"M6"）.Select
Selection.PasteSpecial Paste:
=xlPasteValues, Operation:
=xlNone, SkipBlanks _
:
=False, Transpose:
=False
Range（"N6"）.Select
[N6:
S183] = ""
Sheets（"银行帐"）.Select
[A7:
u3000] = ""
[K5].Copy
Range（"K6"）.Select
Selection.PasteSpecial Paste:
=xlPasteValues, Operation:
=xlNone, SkipBlanks _
升级会员 