(excel100个常用宏)(excel如何自动运行宏)

1、 基于VB和EXCEL的报表设计及打印

在现代管理信息系统的开发中，经常涉及到数据信息的分析、加工，

最终还需把统计结果形成各种形式的报表提供给领导决策参考，或进行外

部交流在Visual Basic中制作报表，通常是用数据环境设计器(Data

Environment Designer)与数据报表设计器(Data Report Designer),或者

使用第三方产品来完成但对于大多数习惯于Excel报表的用户而言,用以

上方法生成的报表在格式和功能等方面往往不能满足他们的要求

由于Excel具有自己的对象库，在Visual Basic工程中可以加以引用，

通过对Excel使用OLE自动化，可以创建一些外观整洁的报表，然后打印输

出这样实现了Visual Basi应用程序对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

2、 提高EXCEL中VBA的效率

3、 方法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程序代码，提高程序的运行速度

4、 方法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

5、 方法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

6、 方法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 _

:=False, Transpose:=False

Application.CutCopyMode = False

Range("A1").Select

End If

Else: MsgBox "密码错误，即将退出！" '此行与第2行共同设置密码

End If

Application.ScreenUpdating = True

End Sub

Sub 打日报表()

Application.ScreenUpdating = False

Sheets("日报表").Select

Call 重算所有表

ActiveSheet.Unprotect Password:=641112 '撤消工作表保护并取消密码

Selection.AutoFilter Field:=1, Criteria1:="1.00 "

'自动筛选

'以下10行弹出窗口输入打印信息

Dim myPrintNum As Integer

Dim myPrompt, myTitle As String

myPrompt = "请输入要打印的份数"

myTitle = "打印选取范围"

myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1)

If myPrintNum <> 0 Then

' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL 6 在 Ne00:" '指定打印机

ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum, Collate:=True '设置打印信息,其中Copies:=myPrint为打印份数

Else

MsgBox "请输入要打印的份数"

End If

ActiveSheet.ShowAllData '全部显示

ActiveSheet.Protect Password:=641112 ' 保护工作表并设置密码

Sheets("封面").Select

Application.ScreenUpdating = True

End Sub

Sub 打印余额()

Application.ScreenUpdating = False

Sheets("余额表").Select

Call 重算所有表

ActiveSheet.Unprotect Password:=641112 '撤消工作表保护并取消密码

ActiveWindow.ScrollColumn = 10

Selection.AutoFilter Field:=1, Criteria1:="<>"

'以下10行弹出窗口输入打印信息

Dim myPrintNum As Integer

Dim myPrompt, myTitle As String

myPrompt = "请输入要打印的份数"

myTitle = "打印选取范围"

myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1)

If myPrintNum <> 0 Then

' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL 6 在 Ne00:" ' '指定打印机

ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum, Collate:=True '设置打印信息,其中Copies:=myPrint为打印份数

Else

MsgBox "请输入要打印的份数"

End If

ActiveSheet.ShowAllData '全部显示

ActiveSheet.Protect Password:=641112 ' 保护工作表并设置密码

Sheets("封面").Select

Application.ScreenUpdating = True

End Sub

Sub 备份()

Dim y '变量声明-需保存工作表的路径和名称

[M1] = ActiveWorkbook.FullName '单元格M1=当前工作簿的路径和名称

y = cells(1, 14) 'Y=单元格N1的值,即计算后的需保存工作簿的路径和名称

Worksheets("封面").UsedRange.Columns("M:N").Calculate '计算指定区域

ActiveWorkbook.SaveCopyAs y '备份到指定路么Y

End Sub

Sub 重算活动表()

With Application

.Calculation = xlManual

.MaxChange = 0.001

End With

ActiveWorkbook.PrecisionAsDisplayed = True

ActiveWindow.DisplayZeros = True

ActiveSheet.Calculate

End Sub

Sub 重算指定表()

Attribute 重算指定表.VB_ProcData.VB_Invoke_Func = "z\n14"

Worksheets("银行帐").Calculate

Worksheets("日报表").Calculate

End Sub

单元格数据改变引起计算激活过程

Private Sub Worksheet_Change(ByVal Target As Range)

Dim irow, icol As Integer

irow = Target.Row '变量行irow

icol = Target.Column '变量列icol

If irow > 6 And icol = 3 And cells(irow, 3) >= cells(irow - 1, 3) Then '>大于6行,并且第3列,当本行 3列>2行3列

Application.EnableEvents = False

cells(irow, 2) = cells(irow - 1, 2) '本行 2 列=上一行2列

Application.EnableEvents = True

ElseIf irow > 6 And icol = 3 And cells(irow, 3) < cells(irow - 1, 3) Then '>大于6行,并且第3列,当本行 3列>2行3列

Application.EnableEvents = False

cells(irow, 2) = cells(irow - 1, 2) + 1 '本行 2 列=上行2列+1

Application.EnableEvents = True

ElseIf (icol = 3 Or icol = 4 Or icol = 6 Or icol = 8 Or icol = 9 Or icol = 10 Or icol = 12 Or icol = 13) And irow > 6 Then 'And Target <> ""

Application.EnableEvents = False

cells(irow, 5) = "=单位名称"

cells(irow, 7) = "=摘要"

cells(irow, 11) = "=余额"

Range(cells(irow, 14), cells(irow, 16)) = "=预内外收支NOP"

cells(irow, 17) = "=审核Q"

cells(irow, 18) = "=对帐U"

Range(cells(irow, 19), cells(irow, 20)) = "=内转收支XY"

cells(irow, 21) = "=政采Z"

Application.EnableEvents = True

End If

End Sub

'计算当前工作表路径及名称的函数,可作为单元格公式,也可写入宏

=CELL("FILENAME")

'改变Excel界面标题的宏

Private Sub Workbook_Open()

Application.Caption = "吃过了"

End Sub

'自动刷新单元格A1内显示的日期\时间的宏

Sub mytime()

Range("a1") = Now()

Application.OnTime Now + TimeValue("00:00:01"), "mytime"

End Sub

'用单元格A1的内容作为文件名保存当前工作簿的宏

Sub b()

ActiveWorkbook.SaveCopyAs Range("A1") + ".xls"

End Sub

'激活窗体的宏,此宏写入有窗体的工作表内

Private Sub CommandButton1_Click() '点数据录入按钮控件激活窗体

Load UserForm3 '激活窗体

UserForm3.StartUpPosition = 3 '激活窗体

UserForm3.Show '激活窗体

End Sub

'以下为窗体中点击各按钮运行的宏,写入窗体内

Public pos As Integer '声明变量pos

'战友确定按钮语句

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False '此句和最后一句旨在不显示宏的执行过程

'On Error GoTo ErrorHandle '可以不要

'ErrorHandle: '可以不要

'If Err.Number = 13 Then '可以不要

'Exit Sub '可以不要

'End If '可以不要

Call writeToWorkSheet '执行宏writetoworksheet

UserForm3.Hide '退出窗体,继续按钮少此句,退出按钮执行此句

Unload UserForm3 '退出窗体,继续按钮少此句,退出按钮执行此句

Call 批量打印 '[此处到接顺序2]

[L2] = "" '[到此处结束]

Sheets("打印信息").Select

Application.ScreenUpdating = True

End Sub

'退出按钮语句

Private Sub CommandButton2_Click()

UserForm3.Hide

Unload UserForm3

End Sub

'将窗体内的文本框中的数据写进工作表的单元格

Private Sub writeToWorkSheet()

ActiveSheet.Range("k2") = TextBox1.Value '将文字框内容写进k列

ActiveSheet.Range("l2") = TextBox2.Value '将文字框内容写进l列

TextBox1.Value = "" '清空文字框内容

TextBox2.Value = "" '清空文字框内容

Worksheets("打印信息").Range("a2").Value = 1 '给指定表的单元格写入数据

Worksheets("打印信息").Range("B3:E113").Value = "" '清空指定表的单元格数据

End Sub

'以下为根据条件打印的宏

Sub 打印() '部门明细查询及批星打印

Application.ScreenUpdating = False '关闭屏幕更新

If Cells(1, 4) = "" And Cells(1, 5) = "" Then '打印条件Cells(3, 13) = 1 And

' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL 6 在 Ne00:" ' '指定打印机

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True '设置默认打印机的打印信息,其中Copies:=myPrint为打印份数

Else

Call 打印信息 '打倒为假时执行

End If

Application.ScreenUpdating = True '关闭屏幕更新

End Sub

'以下的循环过程,也用于批量打印,Z的值可以是Z=1 TO 5(1到5),也可是单元格的内容

Sub 批量打印()

For Z = Cells(1, 11) To Cells(1, 12) '变量X的值从打印起始号K1到结束号L1之间逐渐递增

Cells(1, 13) = Z 'M1的值等于变量X

Next Z

End Sub

'以下是将打印情况写入工作表的宏

Sub 打印信息()

Application.ScreenUpdating = False '关闭屏幕更新

Dim Y '声明变量

Y = ActiveSheet.Name '判定活动工作表名称

Sheets("打印信息").Select

X = 3 '从第3行开始

Do While Not (IsEmpty(Cells(X, 2).Value)) '判断第1列的最后一行(即空行的上一行)

X = X + 1 '在最后一行加一行即为空行

Loop

Cells(X, 2) = Cells(2, 1)

Cells(X, 3) = Sheets(Y).Cells(4, 3)

Cells(2, 1) = Cells(2, 1) + 1

Cells(X, 4) = Sheets(Y).Cells(1, 4)

Cells(X, 5) = Sheets(Y).Cells(1, 5)

[c1] = Y

Sheets(Y).Select '返回上一次打开的工作表

Application.ScreenUpdating = True '打开屏幕更新

End Sub

将文件保存为以某一单元格中的值为文件名的宏怎么写

假设你要以Sheet1的A1单元格中的值为文件名保存，则应用命令：

ActiveWorkbook.SaveCopyAs Str(Range("Sheet1!A1")) + ".xls"

在Excel中,如何用程式控制某一单元格不可编辑修改?thanks!!!

Private Sub Workbook_Open()

ProtectSpecialRange ("A1")

End Sub

Sub ProtectSpecialRange(RangeAddress As String)

On Error Resume Next

With Sheet1

.Cells.Locked = False

.Range(RangeAddress).Locked = True

.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range(RangeAddress) _

, Password:="pass"

.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End With

End Sub

对工作表编程，有时要判断工作表的记录总数，VBA里如何实现？

x=1

do while not (isempty(sheets("").cells(x,1).value)

x=x+1

loop

在VBA中等同于EXCELE中的求和函数-sum()-的函数是什么?

Application.WorksheetFunction.Sum()

自定义菜单有三个菜单项，要求手工顺序执行为防止误操作，执行完第一个菜单项后使其变灰（禁用），如何写？

Rowen

令其 Enable　属性同步与某个工具按钮是较为方便的

如何进行表格更新？

是这样的，比如我已经有了一个原始表格A，这时有人通知我A表有错误，须加以修改，并给我一个表B，表B列出了须修改的参数（注意B的列数少于A的列数，因A的其他列无需修改）现在问题是如何根据表B中的新值，在表A中找到相应位置，并加以修改比如表B中列出了10002的JOHN的身高和体重等值需要修改，如何在A中找到10002的相应位置（身高体重），并加以修改

建议将表b复制至表a的sheet2，然后执行下列的宏即可

sub change()

dim dd as range

sheets(2).select

lastcell = range("a65536").end(xlup).row

for each dd in range(cells(2, 1), cells(lastcell, 1))

if dd = "" then exit sub

ff = dd.value

set c = sheets(1).columns(1).find(ff, lookat:=xlwhole)

if not c is nothing then

c.offset(0, 2) = dd.offset(0, 2)

c.offset(0, 3) = dd.offset(0, 3)

c.offset(0, 5) = dd.offset(0, 4)

end if

next

end sub

自定义菜单

把建立和删除自定义菜单的代码分别写在Workbook_open和Workbook_beforeclosed的事件中

应该用VBA，工作薄代码中有workbook-open()过程，在该过程中写入

with activeworkbook

.sheets("表2").active

end with

VBA实现向锁定工作表中插入行,并自动复制上面行中指定列的函数

Option Explicit

Public Const strPass = "123" 123是口令

Sub 行上再插入一行()

ActiveSheet.Unprotect password:=strPass

Selection.Copy

Selection.Insert Shift:=xlDown

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

ActiveSheet.Protect password:=strPass

End Sub

如何使不出现每次关闭XLS文件时出现的：

“XXX.xls文件已被修改，是否可在其修改后的内容？”字样？？

可以在工作表关闭之前进行手工保存工作

ThisWorkbook.save

如何实现动态时间显示?

sub mytime

range("a1")=now()

Application.OnTime Now + Timevalue("00:00:01"), "mytime"

end sub

用 vba 判断指定 excel 文件是否打开？

For Each w In Workbooks

If w.Name <> XXX Then

…………

End If

Next w

vba怎么调用excel自带的函数?比如vlookup?

Application.WorksheetFunction.f(x)

f(x)是你想使用的工作表函数

但是用内部函数时引用单元格会出错，怎么办？

把你要引用的单元格改成VBA认可格式（类型）如在Excel中的“F7:F12”应改为“Range("F7:F12")”等

VBA中如何关闭,保存和退出Excel?

Workbooks("你的工作簿").Save

下表举例说明了使用 Rows 和 Columns 属性的一些行和列的引用

引用 含义

Rows(1) 第一行

Rows 工作表上所有的行

Columns(1) 第一列

Columns("A") 第一列

Columns 工作表上所有的列

若要同时处理若干行或列，请创建一个对象变量并使用 Union 方法，将对 Rows 属性或 Columns 属性的多个调用组合起来下例将活动工作簿中第一张工作表上的第一行、第三行和第五行的字体设置为加粗

Sub SeveralRows()

Worksheets("Sheet1").Activate

Dim myUnion As Range

Set myUnion = Union(Rows(1), Rows(3), Rows(5))

myUnion.Font.Bold = True

End Sub

如果只是你说的只连接几个储存格那用简单的方法

Range("A1").Formula = Application.Evaluate("=[Book2.xls]Sheet1!A1")

或

Range("A1").Formula = "=[Book2.xls]Sheet1!A1"

请问在vba如何呼叫已定义的名称范围

我在a1:b100插入名称∶myrange

请问我如何用vba选取此范围

Range("myrange").Select

如何访问没有打开的EXCEL文件？

Sub AlternativeImport()

Dim xlapp As Excel.Application

Dim wbSource As Excel.Workbook

Set xlapp = New Excel.Application

xlapp.EnableEvents = False

Set wbSource = xlapp.Workbooks.Open("C:\test\Book2.xls")

Range("A1:A10").Value = wbSource.Sheets("Sheet1").Range("A1:A10").Value

wbSource.Close False

xlapp.Quit

End Sub

7、 怎样使VBAprject工程不可查看？（不用密码）

用可编辑十六进制文件的软件工具（如WinHex等）打开Excel.xls,在文件的尾部,查找ID="{00000000-0000-0000-0000-000000000000}"(有工程锁定密码时),或ID="{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}"(没有工程锁定密码时),修改其中的任意1位后,保存,即可达到目的.当查看工程是会出现“工程不可查看”的提示.

注意:修改前,一定要备份原文件,以防不测

8、 如何用VBA控制报表的格式（左边距，纸张大小，打印第几页等）

打印第几页控制:ActiveWindow.SelectedSheets.PrintOut From:=x, To:=y

ActiveSheet.PageSetup.LeftMargin= 左边距

ActiveSheet.PageSetup..PaperSize = 纸张大小

9、 如何使VBA自动消除使用COPY复制后产生的虚线框？

Application.CutCopyMode = False

替换Excel 97的菜单栏是很容易的，只需创建一个新的菜单栏就会删除Excel 97的菜单栏当需要恢复Excel 97的菜单栏时，只要删除新创建的菜单栏就可以了该系统的自定义菜单中只需两个命令按钮，一个用来返回到系统的主画面（ReturnMAIN），另一个用来退出系统（ExitSYS）下面是模块（Module）中有关的宏或是事件控制程序

Sub ZapMenu( )

On Error Resume Next

CommandBars(“保险查询系统”).Delete

End Sub

这是一个用来删除自定义菜单栏的宏语句On Error Resume Next保证无论自定义菜单栏是否存在都能正确删除它

Sub ExitSYS( )

ZapMenu

ActiveWorkbook.Close SaveChanges := False

End Sub

这是用来退出系统的宏它删除自定义菜单，并关闭活动的工作簿（不提示保存修改）

Sub ReturnMAIN( )

Worksheets(“保险查询系统”).Select

End Sub

该宏用来返回主画面它激活“保险查询系统”工作表

Sub SetMenu( )

Dim myBar As CommandBar

Dim myButton As CommandBarButton

ZapMenu

Set myBar = CommandBars.Add(Name:=“保险查询系统”, _

Position :=msoBarTop, _

MenuBar :=True)

Set myButton = myBar.Controls.Add(msoControlButton)

myButton.Style = msoButtonCaption

myButton.Caption = “退出[&E]”

myButton.OnAction = “ExitSYS”

Set myButton = myBar.Controls.Add(msoControlButton)

myButton.Style = msoButtonCaption

myButton.Caption = “返回[&R]”

myButton.OnAction = “ReturnMAIN”

myButton.Visible = False

myBar.Protection = msoBarNoMove + msoBarNoCustomize

myBar.Visible = True

End Sub

这个宏包含五部分第一部分定义了一对变量第二部分首先运行ZapMenu宏，保证保险查询系统菜单栏是不存在的，然后创建它参数MenuBar的值设为True，确保这个新创建的命令栏为一菜单栏第三部分和第四部分将两个命令按钮加入到菜单栏中并设置ReturnMAIN命令按钮的初始状态为不可见状态最后一部分保护这个新创建的菜单栏，使用户不能移动也不能自定义新菜单栏

10、 工作表汇总

Sub sum() '表汇总,第1张的a1:e20等于所有表的相同单元格的和

Attribute sum.VB_ProcData.VB_Invoke_Func = "z\n14"

Dim X As Worksheet

For y = 1 To 20

For z = 1 To 5

For Each X In Worksheets

shname = X.Name

ActiveSheet.Cells(y, z).Value = ActiveSheet.Cells(y, z).Value + Worksheets(shname).Cells(y, z)

Next

Next z

Next y

End Sub