EXCEL VBA 备忘录

最最基础的什么录制，加快捷键，被禁用宏，……等基本操作直接过滤，这些还不会的，请百度。此文主要备忘常用的编程语句或语法。

range(“A1”).value 对象和属性之间用点连接，value代表单元格值

range(“A1”).select select表示在a1单元格上执行选择

public sub mysub()

magbox "hello world!" ‘magbox是弹出提示框，后面双引号为弹出的内容

end sub

数据类型	存储空间（字节）	范围描述
Byte	1	保存0--255的整数
Boolean	2	保存逻辑判断的结果：True或False
Integer	2	保存-32768--32768的整数
Long	4	保存-2147483648--2147483648的整数
Single	4	负值范围：-3.402823E38-- -1.401298E-45 正值范围：1.401298E-45-- 3.402823E38
Double	8	负值范围：-1.79769313486232E308-- -4.94065645841247E-324 正值范围：4.94065645841247E-324-- 1.79769313486232E308
Currency	8	数值范围：-922337203685477.5808-- 922337203685477.5807
Decimal	14	不含小数时：+/-79228162514264337593543950335 包含小数时：+/-7.9228162514264337593543950335 最小非零数字：+/-0.000000000000000000000000001
Date	8	日期范围：100年1月1日--9999年12月31日时间范围：0:00:00--23:59:59
String(变长)	10字节加字符串长度	0到大约20亿个字符
String(定长)	字符串长度	1到大约65400个字符
Object	4	对象变量，用来引用对象
Variant(变体型)		除了定长String数据及用户定义类型外，可以包含任何种类的数据。如果是数值，最大可达Double的范围;如果是字符，与变长String的范围一样
用户自定义		每个元素的范围与它本身的数据类型的范围相同

Dim 变量名 As 数据类型变量名必须以字母（或汉字）开头，不能包含标点符号，不超过255个字符（1汉字=2字符）

dim str as string*10 表示这个变量只能存储10个字符

dim str$ $表示把变量声明为string变量类型

integer: % long: & single: ! double: # currency: @ string: $

声明多个变量，可以写在同一个dim后面，变量名之间用逗号隔开。

如果不指定变量类型，则变量声明为Variant类型

设置强制申明变量

option explicit

sub test()

a = "我是变量！"

msgbox a

end sub

运行会提示没有申明变量

public 变量名 as 数据类型变量将被申明为公共变量

private 变量名 as 数据类型变量将被申明为私有变量

static 变量名 as 数据类型变量将被申明为静态变量，在整个代码运行期间都会保留该变量的值

const p as single = 3.14 申明single常量，名称为p,值为3.14

dim arr（1 to 50）as string 该语句声明一个string类型的数组，名称为arr，可以存储50个元素
arr(1) = 1 给变量赋值
sub sztest_2()
dim arr(1 to 10) as integer, i as integer
for i = 1 to 10
arr(i) = i
next
end sub

dim arr(1 to 3,1 to 20) 声明多维数组
dim arr(2,19) 与上面一样，不同的写法
定义变量时 arr(1,2) = ??

sub dtsz()
dim arr() as string '定义数组
dim n as long
'统计A列有多少个非空单元格
n = application.worksheetfunction.counta(range("a:a"))
redim arr(1 to n) as string '重新定义数组的大小
end sub
使用dim语句声明变量时，括号内的参数不能是变量，所以必须用redim语句重新指定大小
用这样的方式声明的数组称为动态数组
已经定义大小的数组同样可以用redim语句重新指定它的大小。

sub arraytest()
dim arr as variant '使用array函数创建数组，定义变量时，变量类型必须为Variant
'将1到10十个自然数赋给数组arr
arr = array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) '参数是用英文逗号隔开的列表
msgbox "arr数组的第2个元素为：" & arr(1)
end sub

sub splittest()
dim arr as variant '变量类型必须为Variant
'利用split生成数组
arr = split("邓城,林梅,张青,孔丽,冯继伟,孔佳",",") '第2参数为分隔符
msgbox "arr数组的第2个元素为：" & arr(1)
end sub

sub angarr()
dim arr as variant '变量类型必须为Variant
arr = range("a1:c3").value '将a1:c3单元格的内容存储到数组arr里
range("e1:g3").value =arr '将数组arr的数据写入E1：G3单元格区域
end sub

一个一维数组arr，它的最大索引号是UBound(arr);它的最小索引号LBound(arr)；计算数组有多少个元素UBound(arr)-LBound(arr)+1

sub arrcount()
dim arr(10 to 50)
msgbox "数组的最大索引号是：" & UBound(arr) & chr(13)_ 'chr(13)代表一个回车符，相当于按了一次回车键
& "数组的最小索引号是：" & LBound(arr) & chr(13)_
& "数组的元素个数是：" & UBound(arr)-LBound(arr)+1 '&：连接运算符，将两个字符串合并成一个字符串
end sub

如果是多维数组
sub dwsz()
dim arr(1 to 10,1 to 100)
msgbox "第一维的最大索引号是：" & UBound(arr，1) & chr(13)_ 'chr(13)代表一个回车符，相当于按了一次回车键
& "第一维的最大索引号是：" & LBound(arr，2)
end sub

join 函数
此函数将一个一维数组里的元素使用指定的分隔符连接成一个新的字符串
sub jointest()
dim arr as variant, txt as string '定义2个变量
arr = array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9) '利用array函数创建一个数组arr
txt = join(arr,"@") '将arr数组的元素连接成字符串，用@作分隔符
msgbox txt
end sub

sub arrtorng1()
dim arr as variant
arr = array(1, 2, 3, 4, 5, 6, 7, 8, 9)
'将数组批量写入单元格
range("a1:a9").value = application.worksheetfunction.transpose(arr) ' 将一维数组写入单元格区域，必须在同一行，如果要写入一列，必须先使用transpose 函数转置
end sub

sub arrtorng2()
dim arr(1 to 2,1 to 3) as string '定义一个2行3列的二维数组
arr(1, 1) = 1
arr(1, 2) = "张勇"
arr(1, 3) = "男"
arr(2, 1) = 2
arr(2, 2) = "林梅"
arr(2, 3) = "女"
range("a1:c2").value = arr '将数组批量写入单元格区域，6个元素对应6个单元格，且数组与单元格都是2行3列
end sub

application.workbooks("book1").worksheets("sheet2").range("a2")    '不同级别的对象之间用 . 连接
application 代表excel程序
workbooks   工作簿集合，表示打开的所有工作簿
book1       工作簿的名称
worksheets 工作表集合，表示指定工作簿的所有工作表

运算符：+ - * / \(整除) ^(指数运算) Mod（求模运算，取余数）
比较运算符：= < >   <= >= <> is(比较两个对象的引用变量) like(比较两个字符串是否匹配)
VBA中的通配符： * ？ #（任意一个数字） [charlist]（代替位于charlist中的任意一个字符）     [!charlist]（代替不在charlist中的任意一个字符）
逻辑运算符： and=与   or=或    not=非 xor=异或 eqv=等价   imp=蕴含
运算符的优先级   （） ^ -(求相反数) *,/ \   mod +,- &,+ =,<>,<,>,<=,>=,like,is and,or,not,xor,eqv,imp

sub nowtime()
msgbox"现在的时间是：" &time() 'time函数返回当前系统时间
end sub

if time <0.5 then msgbox "早上好！"
if: 如果
time:函数返回当前系统时间
<:判断当前系统时间是否小于中午12点，返回TRUE或者FALSE
0.5：2分之1天，即12小时，表示中午12点。
then:那么

sub sayhello()
if time<0.5 then msgbox "早上好！"
if time>=0.5 then msgbox "下午好！"
end sub

if time<0.5 then msgbox "早上好！" else msgbox "下午好！"

if time<0.5 then
msgbox "早上好！"
else
msgbox "下午好！"
end if

if time<0.5 then
msgbox "早上好！"
else if time>0.75 then
msgbox "晚上好！"
else
msgbox "下午好！"
end if

select case time
case is<0.5
    msgbox "早上好！"
case is>0.75
    msgbox "晚上好！"
    case else
msgbox "下午好！"
end select

sub xingji()
dim xj as string
select case cells(2, "H") '表示H2
    case is <85
      xj = "不评定"
    case is <100
      xj = "一星级"
    case is <115
      xj = "二星级"
    case is <130
      xj = "三星级"
    case is <150
      xj = "四星级"
    case else
      xj = "五星级"
end select
cells(2,"i") = xj
end sub

sub xingji()
dim xj as string,i as integer
for i = 2 to 19 step 1
    select case cells(i, "H")
      case is <85
        xj = "不评定"
      case is <100
        xj = "一星级"
      case is <115
        xj = "二星级"
      case is <130
        xj = "三星级"
      case is <150
        xj = "四星级"
      case else
        xj = "五星级"
    end select
    cells(i,"I") = xj
next i
end sub

sub xingji()
dim xj as string,i as integer
i = 2
do while cell(i, "H")<>""
     select case cells(i, "H")
      case is <85
        xj = "不评定"
      case is <100
        xj = "一星级"
      case is <115
        xj = "二星级"
      case is <130
        xj = "三星级"
      case is <150
        xj = "四星级"
      case else
        xj = "五星级"
    end select
    cells(i,"I") = xj
i = i + 1
loop
end sub

sub xingji_1()
dim xj as string,i as integer
i = 2
do until cell(i, "H") = ""
     select case cells(i, "H")
      case is <85
        xj = "不评定"
      case is <100
        xj = "一星级"
      case is <115
        xj = "二星级"
      case is <130
        xj = "三星级"
      case is <150
        xj = "四星级"
      case else
        xj = "五星级"
    end select
    cells(i,"I") = xj
i = i + 1
loop
end sub

sub shtname() '把所有当前工作簿的工作表名称按次序写入A列
dim sht as worksheet,i as integer   '定义变量，因为在工作表集合里循环，所以变量类型必须定义为worksheet，即工作表类型
i = 1
fro each sht in worksheets    'worksheets当前活动工作簿中的所有工作表的集合，集合里有几个工作表对象，运行程序后就执行循环体几次。
     cells(i, "A") = sht.name   'sht.name 返回变量sht代表的工作表的标签名称
     i = i + 1
next sht                      '返回for each语句开始处，再次执行循环体，变量名可以省略，直接写next
end sub

sub he()
dim mysum as long, i as integer
i = 1
x: mysum = mysum + i                       'x:标签就像公路旁的指示牌，告诉驾驶员应该把车开向哪里。如果是字符串标签，请记得在后面加上英文冒号。
i = i + 1
if i <=100 then goto x                   '如果i小于或等于100,转到x标签处；不管是文本标签还是数字标签，GOTO后面的标签名都不加冒号和引号
msgbox "1到100的自然数和是：" & mysum
end sub

sub fontset()
   worksheets("sheet1").range("a1").font.name = "仿宋"   '设置字体
   worksheets("sheet1").range("a1").font.size = 12       '设置字号
   worksheets("sheet1").range("a1").font.bold = True     '设置字体加粗
   worksheets("sheet1").range("a1").font.colorindex = 3 '设置字体颜色
end sub

sub fontset()
   with worksheets("sheet1").range("a1").font
       .name = "仿宋"   '设置字体
       .size = 12       '设置字号
       .bold = True     '设置字体加粗
       .colorindex = 3 '设置字体颜色
   end with
end sub

sub macro1()       'macro1是过程名称，过程总是以sub过程名和一对括号开始
range("A1:A8").select    '操作EXCEL或处理数据的代码，一个过程可以有任意多的代码
selection.copy
range("C1").select
activesheet.paste
end sub            '所有的sub过程都是以end sub结束

[Private|Public] [Static] Sub 过程名（[参数列表]）
'private和public用于声明过程的作用域名，同时只能选用1个，如果省略，过程默认为公共过程；如果选用Static，运行程序的过程中将保存该过程里声明的本地变量
[语句块]
[Exit Sub] 'exit sub 可选语句，执行它将中断执行并退出过程
[语句块] '所有[]内的内容都是可选的
End Sub

在A过程中调用B过程
sub runsub()
sayhello '过程名[参数1，参数2]
end sub

sub runsub_2()
call sayhello 'call过程名[参数1，参数2]
end sub

sub runsub_3()
application.run"sayhello" ' application.run 表示过程名的字符串（或字符串变量）[参数1，参数2]
end sub

function fun() '自定义函数function
fun = int(rnd()*10) + 1
end function

function countcolor()
if range("A1").interior.color = rgb(255,255,0) then
countcolor = 1
else
countcolor = 0
end if
end function

function countcolor()   '统计底纹颜色为黄色的单元格数量
dim rng as range
for each rng in range("A1:A10")   '使用for each语句遍历A1:A10里的所有单元格，依次对A1:A10区域中的各个单元格进行判断
    if rng.interior.color = rgb(255,255,0) then      '在for each 循环语句里嵌套if语句
      countcolor = countcolor + 1                  '如果单元格的底纹颜色为黄色，函数值增加1
    end if
next rng
end function

还可以通过索引号来引用某个颜色
range("A1").interior.colorindex = 6 '6表示黄色的索引号

function countcolor(arr as range)   '指定函数的参数为一个range型，即单元格变量，名称为arr
dim rng as range
for each rng in arr     '依次判断arr变量，代表的单元格区中每个单元格的底纹颜色
    if rng.interior.color = rgb(255,255,0) then
       countcolor = countcolor + 1
    end if
next rng
end function
为函数设置参数之后，如果要统计A1：C10中的黄色底纹单元格的个数，输入“=countcolor(A1：C10)”即可

function countcolor(arr as range，c as range)   '指定函数的第二个参数为一个range型变量，名称为c
dim rng as range
for each rng in arr
    if rng.interior.color = c.interior.color then '依次判断单元格的颜色是否与函数第2参数的单元格的底纹相同
       countcolor = countcolor + 1
    end if
next rng
end function
输入“=countcolor(A1：C10，E1)”

public function fun()
application.volatile True '新添加的语句，写在过程开始的第一句
fun = int(rnd()*10) + 1
end function
使用application.volatile True 语句是将自定义函数声明为易失性函数。当工作表发生重算后，易失性函数会重新计算函数的值。

声明函数过程，规范的语句
[Public|private][Static]Function 函数名([参数列表])[As 数据类型]
[语句块]
[函数名=过程结果]
[Exit Function]
[语句块]
[函数名=过程结果] '最后必须把函数计算的结果赋给函数名。这一步必不可少。
End Function

application:代表EXCEL应用程序
workbook:代表excel中的工作簿，一个workbook对象代表一个工作簿文件
worksheet:代表excel中的工作表，一个worksheet对象代表工作簿里的一张普通工作表
range:代表excel中的单元格，可以是单个单元格，也可以是单元格区域

application.screenupdating = false '关闭屏幕更新
application.screenupdating = True '恢复屏幕更新

application.displayalerts = false '不显示警告信息
application.displayalerts = True '恢复显示警告信息

private sub worksheet_selectionchange(byval target as range) 'target变量代表用户当前选中的单元格
target.value = target.address '将选中的单元格地址写入该单元格
end sub

private sub worksheet_selectionchange(byval target as range)   'target变量代表用户当前选中的单元格
   target.value = target.address      '将选中的单元格地址写入该单元格
   application.enableevents = false   '禁用事件
   target.offset(1,0).select          '选中活动单元格下面的一个单元格
   application.enableevents = true    '启用事件
end sub

sub counttest()
   dim mycount as integer,rng as range
   for each rng in range("a1:b50")                      '在A1：B50单元格里循环
       if rng.value > 1000 then mycount = mycount + 1   '如果满足条件，数量+1
   next
   msgbox "a1:b50中大于1000的单元格个数为：" & mycount '提示框显示结果
end sub

sub counttest()
   dim mycount as integer
   mycount = application.worksheetfunction.countif(range("A1:B50"),">1000")
   msgbox "a1:b50中大于1000的单元格个数为：" & mycount '提示框显示结果
end sub
使用工作表函数时，应加上application.worksheetfunction

application.caption = "microsoft excel"   '修改标题栏
application.displayformulabar = False     '隐藏编辑栏
application.displaystatusbar = False      '隐藏状态栏
application.statusbar = "正在计算，请稍等......"      '更改状态栏中显示信息
application.statusbar = False      '恢复状态栏为初试状态
activewindow.displayheadings = False    '隐藏行标和列标

activewindow.displayworkbooktabs = False   '隐藏工作表标签
activewindow.displayhorizontalscrollbar = False   '隐藏水平滚动条
activewindow.displayverticalscrollbar = False   '隐藏垂直滚动条
application.commandbars("darwing").visible = False   '显示绘图工具栏
application.commandbars("standard").visible = False   '隐藏常用工具栏
activewindow.displaygridlines = False   '隐藏网格线

application的常用属性
activecell       当前活动单元格
activechart      当前活动工作簿中的活动图表
activesheet      当前活动工作簿中的活动工作表
activewindow     当前活动窗口
activeworkbook   当前活动工作簿
charts           当前活动工作簿中所有的图表工作表
selection        当前活动工作簿中所有选中的对象
sheets           当前活动工作簿中所有sheet对象，包括普通工作表、图表工作表、msexcel4.0宏表工作表和msexcel5.0对话框工作表
worksheets       当前活动工作簿中的所有worksheet对象（普通工作表）
workbooks        当前所有打开的工作簿

sub wbmsg()
range("b2") = thisworkbook.name 'thisworkbook代码所在的工作簿
range("b3") = thisworkbook.path
range("b4") = thisworkbook.fullname
end sub

workbooks.add '不带任何参数，将创建包含一定数据空白工作表的新工作簿
workbooks.add "c:\program files\microsoft office\templates\2052\address.xls" 'add后面有一个空格，参数是现有excel文件名的字符串。选用该参数，新建的工作簿将以该文件作为模板
workbooks.add xlwbatchart '参数告诉vba 新建的工作簿包含1张图表工作表
xlwbatchart 图表工作表；xwbatworksheet 普通工作表；xlwbatexcel4macrosheet ms excel 4.0宏表工作表；xlwbatexcel4intlmacrosheet ms excel 5.0对话框工作表

sub openfile()
workbooks.open filename:="f:\book1.xls" '打开F盘的Book1.xls也可以写成 workbooks.open "f:\book1.xls"
end sub

sub jhwb()
workbooks("book1").activate '激活book1工作簿
end sub

sub savewb()
thisworkbook.save '保存代码所在的工作簿
end sub

sub savetofile()
thisworkbook.saveas filename:="d:\test.xls" '参数指定文件保存的路径及文件名，如果省略路径，默认将文件保存在当前文件夹中
end sub

sub closewb()
workbooks.close '关闭所有打开的工作簿
end sub

sub closewb()
workbooks("book1").close '关闭book1
end sub

sub closewb()
workbooks("book1").close savechanges:=true '关闭并保存修改也可以写成 workbooks("book1").close true
end sub

sub wb()
workbooks.add
msgbox "代码所在的工作簿为：" & thisworkbook.name   '显示代码所在工作簿名称
msgbox "当前活动工作簿为：" & activeworkbook.name   '显示当前活动工作簿名称
activeworkbook.close savechanges:=false             '关闭新建工作簿，不保存修改
end sub

wroksheets.item(1) '引用工作簿里的第一张工作表
worksheets(1) '引用工作簿里的第一张工作表
worksheets("sheet1") '引用工作簿里标签名称为“sheet1”的工作表

sheet1.range("a1") = 100 '在指定工作表A1单元格输入100

worksheets.add   '插入一张新工作表
worksheets.add before:=worksheets(1) '在第一张工作表前插入一张新工作表
worksheets.add after:=worksheets(1) '在第一张工作表后插入一张新工作表
worksheets.add count:=3   '在活动工作表前插入3张工作表
worksheets.add after:=worksheets(1),count:=3    '在第一张工作表后插入3张工作表

worksheets(2).name = "工资表" '更改第2张工作表的标签名称为“工资表”

sub shtadd()
worksheets.add before:=worksheets(1)
activesheet.name = "工资表"
end sub

sub shtcopy()
worksheets("工资表").copy before:=worksheets("出勤登记表")
end sub

sub shtcopy()
worksheets("工资表").copy after:=worksheets("职工档案")
end sub

不使用参数，默认将工作表复制到新工作簿中
sub shtcopy()
worksheets("工资表").copy
end sub

移动工作表
sub shtmove()
'将“工资表”移动到“出勤登记表”之前
worksheets("工资表").move before:=worksheets("出勤登记表")
'将“工资表”移动到“职工档案”之后
worksheets("工资表").move after:=worksheets("职工档案")
'将“工资表”移动到新工作簿中
worksheets("工资表").move
end sub

隐藏或显示工作表
Worksheets("工资表").Visible = False
Worksheets("工资表").Visible = xlSheetHidden
Worksheets("工资表").Visible = 0
这3句的作用是一样的

Worksheets("工资表").Visible = xlSheetVeryHidden
Worksheets("工资表").Visible = 2
这2句只能在属性窗口取消隐藏

显示工作表
Worksheets("工资表").Visible = True
Worksheets("工资表").Visible = xlSheetVisible
Worksheets("工资表").Visible = 1
Worksheets("工资表").Visible = -1

Sub shtcount()
Dim mycount%
mycount = Worksheets.Count
MsgBox "工作簿里一共有" & mycount & "张工作表！"
End Sub

Worksheets("sheet1").Range("a1") = 50 '这就是地址，地址告诉vba应该把数据保存在哪里。
Sub rng()
Range("a1:a10").Value = 200
Dim n As String
n = "b1:b10"
Range(n) = 100
End Sub

Sub rng()
Range("date").Value = 100 'date参数是表示名称名的字符串，即单元格名称
End Sub
Sub rng()
Range("a1:a10,a4:e6,c3:d9").Select '选中单元格区域
End Sub
Sub rng()
Range("b1:b10 a4:d6").Select '选中多个单元格区域的交集
End Sub
Sub rng()
Range("b6:b10", "d2:d8").Select '选中包含两个单元格区域的最小矩形区域
End Sub

Sub cel()
ActiveSheet.Cells(3, 4).Value = 20 '在第3行与第4列的相交的单元格输入20
End Sub
Sub cel()
ActiveSheet.Cells(3, "D").Value = 20 '在第3行与D列的相交的单元格输入20
End Sub
Sub cel()
Range("b3:f9").Cells(2, 3) = 100 '在b3:f9单元格区域的第2行与第3行相交的单元格
End Sub

Range(Cells(1, 1), Cells(10, 5)).Select   '选中活动工作表的A1：E10单元格
Range("A1", "E10").Select   '选中活动工作表的A1：E10单元格
Range(Range("A1"), Range("E10")).Select   '选中活动工作表的A1：E10单元格

Sub cel()
ActiveSheet.Cells(2).Value = 200 '在活动工作表的第2个单元格输入200
End Sub
Sub cel()
Range("b3:f9").Cells(8).Value = 100 '在b3:f9的第8个单元格输入100
End Sub
Sub cel()
ActiveSheet.Cells.Select '选中活动工作表中的所有单元格
Range("b3:f9").Cells.Select '选中活动工作表中的b3:f9单元格区域
End Sub

ActiveSheet.Rows("3:3").Select     '选中活动工作表的第3行
ActiveSheet.Rows("3:5").Select     '选中活动工作表的第3行到第5行
ActiveSheet.Rows(3).Select         '选中活动工作表的第3行
ActiveSheet.Rows.Select            '选中活动工作表的所有行
Rows("3:10").Rows("1:1").Select    '选中第3行到第10行区域中的第1行

ActiveSheet.Columns ("f:g")        '选中活动工作表中的F至G列
ActiveSheet.Columns (6)            '选中活动工作表中的第6列
ActiveSheet.Columns                '选中活动工作表中的所有列
Columns("B:G").Columns("B:B").Select '选中B:G列区域中的第2列

Sub rngunion()
'同时选中两个单元格区域
Application.Union(Range("A1:A10"), Range("D1:D5")).Select
End Sub

Sub uniontest()                     '声明过程名
Dim myrange As Range, n As Range '定义两个range变量
Set myrange = Range("A1")         '为变量myrange赋值
For Each n In Range("A1:D10")     '遍历A1：D10区域
    If n.Value = Range("A1").Value Then '判断range变量n的内容是否等于A1单元格的内容
    Set myrange = Union(myrange, n) '将range变量n指代的单元格添加进myrange变量中
    End If                          'if语句结束
Next                              '回到FOR语句开始处
myrang.Select                     '选中myrange代表的单元格
End Sub                             '结束过程

Range("A1").Offset(2, 3).Value = 500 '第一个参数2告诉VBA向下移动2行，第二个参数3告诉VBA向右移动3列
Range("C5:D6").Offset(-3, 0).Select   '第一个参数-3告诉VBA向上移动3行，第二个参数0告诉VBA列方向上不移动
Range("b2").Resize(5, 4).Select       '将B2单元格扩大为B2：E6
Range("B2:E6").Resize(2, 1).Select    '将B2:E6单元格区域缩小为B2：B3

ActiveSheet.UsedRange.Select '选中活动工作表中已使用的单元格区域

Range("B5").CurrentRegion.Select '相当于选中B5单元格后按F5，定位“当前区域”得到的单元格区域

Range("C5").End(xlUp).Select '参数xlup告诉VBA，移动的方向是向上，等同于在C5单元格按<end + 上方向键>得到的单元格

xlToLeft            '向左移动，等同于在源单元格按<Ctrl + 左方向键>
xlToRight           '向右移动，等同于在源单元格按<Ctrl + 右方向键>
xlUp                '向上移动，等同于在源单元格按<Ctrl + 上方向键>
xlDown              '向下移动，等同于在源单元格按<Ctrl + 下方向键>

ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = "张青" '在A列A65536个单元格开始往上按方向键得到A列最后一个非空单元格，往下移动一行，在里面输入“张青”

Range("A1:B2").Value = "abc" '在A1：B2输入abc
Range("B1").Value = Range("A1").Value '把A1的内容写入B1
Range("A1:B2") = "abc" '在A1：B2输入abc，不建议这样写程序

ActiveSheet.UsedRange.Rows.Count '求活动工作表中已使用的行数
ActiveSheet.UsedRange.Columns.Count '求活动工作表中已使用的行数

MsgBox "当前选中的单元格地址为：" & Selection.Address

ActiveSheet.Range("A1:B10").Select
ActiveSheet.Range("A1:B10").Activate
'上面两句代码都是等效的，无论那种方法，选中单元格前，单元格所在的工作表都必须是活动工作表。

Range("B2:B15").Clear           '清除B2：B15单元格所有包括批注、内容、注释、格式等内容
Range("B2:B15").ClearComments   '清除B2：B15单元格的批注
Range("B2:B15").ClearContents   '清除B2：B15单元格的内容
Range("B2:B15").ClearFormats    '清除B2：B15单元格的格式

Range("A1").Copy Range("C1") '复制A1到C1
Range("A1").Copy Destination:=Range("C1") '复制A1到C1,Destination:= 可以省略

Range("A1").CurrentRegion.Copy Range("G1") '复制不确定大小的区域，指定左上角的单元格
Range("F1:I10").Value = Range("A1:D10").Value '仅仅复制内容

Range("B5").Delete shift:=xlToLeft       '删除B5单元格，删除后右侧单元格左移
Range("B5").Delete shift:=xlUp           '删除B5单元格，删除后下方单元格上移 = Range("B5").Delete
Range("B5").EntireRow.Delete             '删除B5单元格所在的行
Range("B5").EntireColumn.Delete          '删除B5单元格所在的列

'定义名称
ActiveWorkbook.Names.Add Name:="date", RefersToR1C1:="=Sheet1!R5C[-2]" 'R5表示第5行C[-2]表示活动单元格左边第2列
ActiveWorkbook.Names.Add Name:="date", RefersTo:="=Sheet1!$B$4" '如果不加$，则使用相对引用，将把活动单元格当做A1单元格
Range("A1:C10").Name = "date"

'引用名称
ActiveWorkbook.Names("date").Name = "姓名" '更改名称名
ActiveWorkbook.Names("姓名").RefersTo = "张万平" '更改名称的值

Sub usename_2()
Dim i As Integer, mx As Integer
mx = ActiveWorkbook.Name.Count '统计一共有多少个名称
For i = 1 To mx
ActiveWorkbook.Name (i), Visible = False '隐藏名称
Next
End Sub

Range("B5").AddComment Text:="我用VBA新建的批注"

Sub com()
If Range("B5").Comment Is Nothing Then    '判断是否存在comment对象
    msgbox "B5单元格中没有批注！"
Else
    msgbox "B5单元格中已有批注！"
End If
End Sub

Sub com()
Range("B5").Comment.Text = "更改批注的内容"   '更改批注的内容
Range("B5").Comment.Visible = False           '隐藏批注
Range("B5").Comment.Delete                    '删除批注
End Sub

Font 对象
Sub FontSet()
    With Range("A1:L1").Font
        .Name = "宋体"                           '设置字体为宋体
        .Size = 12                               '设置字号为12
        .Color = RGB(255, 0, 0)                  '设置字体颜色为红色
        .Bold = True                             '设置字体加粗
        .Italic = True                           '设置文字倾斜显示体
        .Underline = xlUnderlineStyleDouble      '给文字添加双下划线
    End With
End Sub

Range("A1:L1").Interior.Color = RGB(255, 255, 0) '添加黄色底纹

Sub BorderSet()
    With Range("A1").CurrentRegion.Borders
        .LineStyle = xlContinuous                 '设置单线边框
        .Color = RGB(0, 0, 255)                   '设置边框的颜色
        .Weight = xlHairline                      '设置边框线条样式
    End With
End Sub

Sub WbAdd()
    '程序创建“员工花名册”工作簿，保存在本工作簿所在的文件夹中。
    Dim wb As Workbook, sht As Worksheet     '定义一个workbook对象和一个worksheet对象
    Set wb = Workbooks.Add                   '新建一个工作簿
    Set sht = wb.Worksheets(1)
    With sht
        .Name = "花名册"                     '修改第一张工作表的标签名称
        '设置表头
        .Range("A1:F1") = Array("序号", "姓名", "性别", "出生年月", "参加工作时间", "备注")
    End With
    wb.SaveAs ThisWorkbook.Path & "\员工花名册.xls" '保存新建的工作表到本工作簿所在的文件夹中
    ActiveWorkbook.Close                            '关闭新建的工作簿
End Sub

Sub IsOpen()
    '判断“成绩表.xls”工作簿文件是否打开。
    Dim i As Integer                             '定义循环变量
    For i = 1 To Workbooks.Count                 '开始循环
        If Workbooks(i).Name = "成绩表.xls" Then '判断工作簿是否打开
            MsgBox "文件已打开！"
            Exit Sub                              '如果找到该文件，退出过程
        End If
    Next
    MsgBox "文件没有打开！"
End Sub

Sub TestFile()
    '判断本工作簿所在的文件夹中是否存在“员工花名册.xls”
    Dim fil As String                           '定义变量
    fil = ThisWorkbook.Path & "\员工花名册.xls"
    If Len(Dir(fil)) > 0 Then                   '用dir判断fil指代的文件是否存在
        MsgBox "工作簿已存在！"
    Else
        MsgBox "工作簿不存在！"
    End If
End Sub

Sub WbInput()
    '在本工作簿所在的文件夹下“员工花名册”里添加一条记录！
    Dim wb As String, xrow As integere, arr
    wb = ThisWorkbook.Path & "\员工花名册.xls"              '指定要打开的文件
    Workbooks.Open (wb)                                     '打开工作簿
    With ActiveWorkbook.Worksheets(1)                       '向工作簿里的第1张工作表里添加记录
        xrow = .Range("A1").CurrentRegion.Rows.Count + 1    '取得表格中第一条空行号
        '将需要增加的职工信息保存在数组arr里
        arr = Array(xrow - 1, "张娇", "女", #7/8/1987#, #9/1/2010#, "10年新招")
        .Cells(xrow, 1).Resize(1, 6) = arr                  '将数组写入单元格区域
    End With
    ActiveWorkbook.Close savechanges:=True                  '关闭工作簿，并保存修改
End Sub

Sub ShtVisible()
    '隐藏活动工作表外的所有工作表！
    Dim sht As Worksheet                    '定义一个worksheet变量
    For Each sht In Worksheets              '遍历所有工作表
        If sht.Name <> ActiveSheet.Name Then
            sht.Visible = xlSheetVeryHidden '深度隐藏工作表
        End If
    Next
End Sub

Sub ShtAdd()
    '根据C列的班级名新建不同的工作表
    Dim i As Integer, sht As Worksheet
    i = 2                                                   '第一条记录的行号为2
    Set sht = Worksheets("成绩表")
    Do While sht.Cells(i, "C") <> ""                        '定义循环条件
        Worksheets.Add after:=Worksheets(Worksheets, Count) '在所有工作表后插入新工作表
        ActiveSheet.Name = sht.Cells(i, "C").Value          '更改工作表的标签名称
        i = i + 1                                           '行号增加1
    Loop
End Sub

Sub ShtAdd_1()
    '根据C列的班级名新建不同的工作表，C列存在重复名称
    Dim i As Integer, sht As Worksheet
    i = 2                                                        '第一条记录的行号为2
    Set sht = Worksheets("成绩表")
    Do While sht.Cells(i, "C").Value <> ""                       '定义循环条件
        On Error Resume Next                                     '当没有对应班级工作表时，忽略下一行代码引起的运行时的错误
        If Worksheets(sht.Cells(i, "C").Value) Is Nothing Then   '判断是否存在对应的班级工作表
        Worksheets.Add after:=Worksheets(Worksheets, Count)      '在所有工作表后插入新工作表
        ActiveSheet.Name = sht.Cells(i, "C").Value               '更改工作表的标签名称
        End If
        i = i + 1                                                '行号增加1
    Loop
End Sub

Sub FenLei()
    '把成绩表按班级分别各个工作表中
    Dim i As Long, bj As String, rng As Range
    i = 2
    bj = Cells(i, "C").Value
    Do While bj <> ""
        '将分表中A列第一个空单元格赋给rng
        Set rng = Worksheets(bj).Range("A65536").End(xlUp).Offset(1, 0)
        Cells(1, "A").Resize(1, 7).Copy rng '将记录复制到相应的工作表中
        i = i + 1
        bj = Cells(i, "C").Value
    Loop
End Sub

Sub ShtClear()
    Dim sht As Worksheet
    For Each sht In Worksheets
        If sht.Name <> "成绩表" Then           '"成绩表"为保存源数据记录的工作表标签名称
        sht.Range("A2:G65536").ClearContents   '清除各分表中的数据记录
        End If
    Next
End Sub

Sub SaveToFile()
    '把各个工作表以单独的工作簿文件保存在本工作簿所在文件夹下的“班级成绩表”文件夹中
    Application.ScreenUpdating = False                             '关闭屏幕更新
    Dim folder As String
    folder = ThisWorkbook.Path & "\班级成绩表"
    '如果文件不存在，新建文件夹
    If Len(Dir(folder, vbDirectory)) = 0 Then mkder folder
    Dim sht As Worksheet
    For Each sht In Worksheets                                     '遍历工作表
        .sht.Copy                                                  '复制工作表到新工作簿
        ActiveWorkbook.SaveAs folder & "\" & sht.Name & ".xls"     '保存工作簿，并命名
        ActiveWorkbook.Close
    Next
    Application.ScreenUpdating = True                              '开启屏幕更新
End Sub

Sub hebing()
    '把各班成绩表合并到“总成绩”工作表中
    Rows("2:65536").Clear                                       '删除原有记录
    Dim sht As Worksheet, xrow As Integer, rng As Range
    For Each sht In Worksheets                                  '遍历工作簿中所有工作表
        If sht.Name <> ActiveSheet.Name Then
            Set rng = Range("A65536").End(xlUp).Offset(1, 0)    '获得A列第一个空单元格
            xrow = sht.Range("A1").CurrentRegion.Rows.Count - 1 '获得分表中的记录条数
            sht.Range("A2").Resize(xrow, 7).Copy rng            '粘贴记录到汇总表
        End If
    Next
End Sub

Sub HzwWb()
    Dim r As Long, c As Long
    r = 1            '1是表头的行数
    c = 8            '8是表头的列数
    Range(Cells(r + 1, "A"), Cells(65536, c)).ClearContents     '清除汇总表中原表数据
    Application.ScreenUpdating = False
    Dim filename As String, wb As Workbook, sht As Worksheet, erow As Long, fn As String, arr As Variant
    filename = Dir(ThisWorkbook.Path & "\*.xls")
    Do While filename <> ""
        If filename <> ThisWorkbook.Name Then                   '判断文件是否是本工作簿
            erow = Range("A1").CurrentRegion.Rows.Count + 1     '取得汇总表中第一条空行行号
            fn = ThisWorkbook.Path & "\" & filename
            Set wb = getboject(fn)                              '将fn代表的工作簿对象赋给变量
            Set sht = wb.Worksheets(1)                          '汇总的是第一张工作表
            '将数据表中的记录保存在arr数组里
            arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(65536, "B").End(xlUp).Offset(0, 8))
            '将数组arr中的数据写入工作表
            Cells(erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
            wb.Close False
        End If
        filename = Dir                '用dir函数取得其他文件名，并赋给变量
    Loop
    Application.ScreenUpdating = True
End Sub

Sub mulu()
    '为工作簿中所有工作表建立目录
    Rows("2:65536").ClearContents                             '清除工作表中原表数据
    Dim sht As Worksheet, irow As Integer
    irow = 2                                                  '在第2行写入第一条记录
    For Each sht In Worksheets                                '遍历工作表
        Cells(irow, "A").Value = irow - 1                     '写入序号
        '写入工作表名，并建立超链接
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(irow, "B"), Address:="", SubAddress:="'" & sht.Name & "'!A1", TextToDisplay:=sht.Name
        irow = irow + 1                                       '行号加1
    Next
End Sub

Private Sub workbook_open()
'每次打开工作簿时都会自动执行下面的程序
MsgBox "你好，祝你工作愉快！"
End Sub

Private Sub workbook_change(ByVal target As Range)
'更改任意单元格值会运行程序
MsgBox target.Address & "单元格的值被更改为：" & target.Value
End Sub

Private Sub workbook_change(ByVal target As Range)
    If target.Column = 1 Then       '判断更改的单元格是否为A列单元格
        MsgBox target.Address & "单元格的值被更改为：" & target.Value
    End If
End Sub

Private Sub workbook_change(ByVal target As Range)
    Application.EnableEvents = False      '禁用事件
    target.Value = "新内容：" & target.Value
    Application.EnableEvents = True       '启用事件
End Sub

Private Sub workbook_selectionchange(ByVal target As Range) 'target是程序运行的参数，代表新选中的单元格区域
MsgBox "当前选中的单元格区域为：" & target.Address
End Sub

Private Sub Worksheet_Activate()
MsgBox "当前活动工作表为：" & ActiveSheet.Name
End Sub

Private Sub Worksheet_Deactivate()
MsgBox "不允许选中sheet1工作表外的其他工作表！"
Workssheets("Sheet1").Select
End Sub

Activate     '激活工作表时发生
BeforeDoubleClick    '双击工作表之后，默认的双击操作之前发生
BeforeRightClick     '右击工作表之后，默认的右击操作之前发生
Calculate            '重新计算工作表之后发生
Change               '工作表中的单元格发生更改时发生
Deactivate           '工作表由活动工作表变为不活动工作表时发生
FollowHyperlink      '单击工作表中的任意超链接时发生
PivotTableUpdate     '在工作表中更新数据透视表之后发生
SelectionChange      '工作表中所选内容发生更改时发生

'Workbook_Open事件告诉EXCEL，当打开工作簿时自动运行程序
Private Sub Workbook_BeforeClose(cancel As Boolean)
    If MsgBox("你确定要关闭工作簿吗？", vbYesNo) = vbNo Then
        cancel = True   '取消关闭
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As boject, ByVal target As Range)
MsgBox "当前更改的工作表为：" & Sh.Name & Chr(13) & "发生更改的单元格地址为：" & target.Address
End Sub

Activate     '当激活工作簿时发生
AddinInstall '当工作簿作为加载宏安装时发生
AddinUninstall '当工作簿作为加载宏卸载时发生
AfterXmlExport '在保存或导出指定工作簿中的xml数据之后发生
AfterXmlImport '在刷新现有xml数据连接或新的xml数据被导入任意一个打开的工作簿后发生
BeforeClose     '在关闭工作簿之前发生。如果工作簿已更改，则此事件在询问用户是否保存更改之前发生
BeforePrint     '在打印指定工作簿（或其中任何内容）之前发生
BeforeSave      '在保存工作簿前发生
BeforeXmlExport '在保存或导出指定工作簿中的xml数据之前发生
BeforeXmlImport '在刷新现有xml数据连接或新的xml数据被导入任意一个打开的工作簿前发生
Deactivate      '在工作簿从活动状态转为非活动状态时发生
NewSheet        '在工作簿中新建工作表是发生
Open            '在打开工作簿时发生
PivotTableCloseConnection '在数据透视表的连接关闭之后发生
PivotTableOpenConnection   '在数据透视表的连接打开之后发生
SheetActivate              '激活任意工作表时发生
SheetBeforeDoubleClick     '双击任意工作表时（默认的双击操作之前）发生
SheetBeforeRightClick      '右击任意工作表时（默认的右击操作之前）发生
SheetCalculate             '在重新计算工作表时或在图表上绘制更改的数据之后发生
SheetChange                '当更改任何工作表中的单元格时发生
SheetDeactivate            '工作表由活动工作表变为不活动工作表时发生
SheetFollowHyperlink       '当单击工作表中的任意超链接时发生
SheetPivotTableUpdate      '在更新数据透视表的工作表之后发生
SheetSelectionChange       '当任意工作表上的选定区域发生更改时发生（但图表工作表上的选定区域发生改变时，不会发生此事件）
Sync             '当作为“文档工作区”一部分的工作簿的本地副本与服务器上的副本进行同步时发生
WindowActivate   '在激活任意工作簿窗口时发生
WindowDeactivate '当任意工作簿窗口由活动窗口变为不活动窗口时发生
WindowResize     '在调整任意工作簿窗口大小时发生

Private Sub cmd_MouseMove(ByVal Button As Integer, ByVal shift As Integer, ByVal x As Single, ByVal Y As Single)
'MouseMove事件告诉EXCEL，当鼠标指针在CMD按钮上移动时自动运行程序
    Dim l As Integer, t As Integer
    l = Int(Rnd() * 10 + 125) * (Int(Rnd() * 3 + 1) - 2) '生成随机数
    t = Int(Rnd() * 10 + 30) * (Int(Rnd() * 3 + 1) - 2) '生成随机数
    cmd.Top = cmd.Top + t '重新设置改按钮的top属性值
    cmd.Left = cmd.Left + l '重新设置改按钮的left属性值
End Sub

Private Sub Back_Click()
'Click告诉EXCEL，当单击按钮时，自动运行程序
cmd.Top = 15 '设置cmd按钮的top属性为15
cmd.Left = 160 '设置cmd按钮的left属性为160
End Sub

Sub ok()
Application.OnKey "+e", "test" '当按下shift+e组合键时，运行test过程
End Sub

Sub test()
MsgBox "你好，我在学习onkey方法！"
End Sub

Sub oT()
'一个小时后，自动运行Test过程
Application.OnTime Now() + TimeValue("01:00:00"), "Test"
End Sub

Private Sub Worksheet_Change(ByVal target As Range)
'如果更改的单元格不是C列第3行一下的单元格或更改的单元格个数大于1时退出程序
    If Application.Intersect(target, Range("c3:c65536")) Is Nothing Or target.Count > 1 Then
        Exit Sub
    End If
    Dim i As Integer
    i = 3
    Do While Cells(i, "I").Value <> ""
    '判断录入的字母与参照表的字母是否相符
        If UCase(target.Value) = Cells(i, "I").Value Then
            Application.EnableEvents = False   '禁用事件，防止将字母改为商品名称时，再次执行程序
            target.Value = Cells(i, "I").Offset(0, 1).Value      '写入产品名称
            target.Offset(0, -1).Value = Date                    '写入销售日期
            target.Offset(0, 1).Value = Cells(i, "I").Offset(0, 2).Value '写入商品代码
            target.Offset(0, 2).Value = Cells(i, "I").Offset(0, 3).Value '写入商品单价
            target.Offset(0, 3).Select                    '选中销售数量列，等待输入销售数量
            Application.EnableEvents = True               '重新启用事件
            Exit Sub
        End If
        i = i + 1
    Loop
End Sub

Private Sub worksheet_selectionchange(ByVal target As Range)
    Range("b3:q22").Interior.ColorIndex = xlNone '清除单元格里原有底纹颜色
    '当选中的单元格个数大于1时，重新给Traget赋值
    If target.Count > 1 Then
        Set target = target.Cells(1)
    End If
    '当选中的单元格不包含指定区域的单元格时，退出程序
    If Application.Intersect(target, Range("b3:q22")) Is Nothing Then
        Exit Sub
    End If
    Dim rng As Range
    '遍历单元格
    For Each rng In Range("b3:q22")
        If rng.Value = target.Value Then
            rng.Interior.ColorIndex = 39
        End If
    Next
End Sub

Private Sub worksheet_selectionchange(ByVal target As Range)
    Range("b3:q22").Interior.ColorIndex = xlNone '清除单元格里原有底纹颜色
    '当选中的单元格个数大于1时，重新给Traget赋值
    If target.Count > 1 Then
        Set target = target.Cells(1)
    End If
    '当选中的单元格不包含指定区域的单元格时，退出程序
    If Application.Intersect(target, Range("b3:q22")) Is Nothing Then
        Exit Sub
    End If
    Dim rng As Range
    '添加底纹颜色
    Range(Cells(target.Row, "B"), Cells(target.Row, "Q")).Interior.ColorIndex = 39
    Range(Cells(3, target.Column), Cells(22, target.Column)).Interior.ColorIndex = 39
End Sub

Sub otime()
'一分钟后自动运行wbsave过程
Application.OnTime Now() + TimeValue("00:01:00"), "wbsave"
End Sub

Sub wbsave()
ThisWorkbook.Save '保存工作簿
Call otime '再次运行otime过程
End Sub

Private Sub workbook_open()
Call otime '打开工作簿后自动运行otime过程
End Sub

Private Sub xb1_chick()
    If xb1.Value = True Then         '如果xb1已选中则执行if与end if之间的代码
        Range("f2").Value = "男"     '在F2单元格里输入“男”
        xb2.Value = False            '更改xb2为未选中状态
    End If
End Sub

Private Sub xb2_chick()
    If xb2.Value = True Then         '如果xb2已选中则执行if与end if之间的代码
        Range("f2").Value = "女"     '在F2单元格里输入“女”
        xb1.Value = False            '更改xb1为未选中状态
    End If
End Sub

Sub inbox() 'inputbox函数
    Dim str As String
    '将输入的值赋给变量str
    str = InputBox(prompt:="请输入姓名", Title:="操作提示", Default:="张娇", xpos:=2000, ypos:=2500) 'prompt是对话框上的提示文字，title是对话框的标题，default是默认输入值如果省

略则为空，xpos是对话框的左端与屏幕左端的距离，ypos是对话框的顶端与屏幕顶端的距离
Range("A1") = str '将输入的值写入A1单元格
End Sub
'除了prompt其他都可以省略

str = InputBox("请输入姓名：")
str = InputBox(prompt:="请输入姓名：")
str = InputBox(prompt:="请输入姓名：", Default:="张三")
str = InputBox("请输入姓名：", , "张三")

Sub appinbox()   'inputbox 方法
    Dim str As String
    '将输入的值赋给变量str
    str = Application.InputBox(prompt:="请输入姓名：", Title:="操作提示", Default:="张娇", Left:=100, Top:=100)    'left = xpos,top = ypos
    Range("A1") = str '将输入的值写入A1单元格
End Sub
'inputbox函数创建的对话框只能返回string类型的字符串；inputbox方法多一个type参数，返回的数据类型不确定。
'多出来的type参数说明：0 = 公式； 1 = 数字； 2 = 文本(字符串)； 4 = 逻辑值（True或False）； 8 = 单元格引用（Range对象）； 16 = 错误值，如#N/A； 64 = 数值数组

Sub rnginput()
    Dim rng As Range        '定义一个range对象
    On Error GoTo cancel    '如果单击“取消”按钮，出现错误，跳转到cancel处
    '将选中的单元格对象赋给变量rng
    Set rng = Application.InputBox(prompt:="请选择需要输入数值的单元格区域", Type:=8)
    rng.Value = 100   '在选中的单元格输入100
cancel:
End Sub

Application.InputBox(prompt:="请输入内容：", Type:=1 + 2) = Application.InputBox(prompt:="请输入内容：", Type:=3) '1表示数字，2表示文本，1+2表示数字和文本任意一种都可以，也可以

写3,3也是表示数字和文本任意一种

Sub msg()
MsgBox prompt:="中午十二点，该吃午饭了！", Buttons:=vbOKOnly + vbInformation, Title:="温馨提醒" 'prompt是对话框中要显示的文本信息，Buttons指定对话框中显示的按钮数目。按钮形

式、使用的图标样式、缺省按钮以及消息框的强制回应，title指定在对话框的标题栏中显示的
End Sub

'msgbox的6种按钮设定
'vbOkonly               0       只显示【确定】按钮
'vbOkCancel             1       显示【确定】和【取消】2个按钮
'vbAbortRetryIgonre     2       显示【终止】、【重试】和【忽略】3个按钮
'vbYesNoCancel          3       显示【是】、【否】和【取消】3个按钮
'vbYesNo                4       显示【是】和【否】2个按钮
'vbRetryCancel          5       显示【重试】和【取消】2个按钮

Sub msgbut()
    MsgBox prompt:="只显示【确定】按钮", Buttons:=vbOKOnly
    MsgBox prompt:="显示【确定】和【取消】2个按钮", Buttons:=vbOKCancel
    MsgBox prompt:="显示【终止】、【重试】和【忽略】3个按钮", Buttons:=vbAbortRetryIgonre
    MsgBox prompt:="显示【是】、【否】和【取消】3个按钮", Buttons:=vbYesNoCancel
    MsgBox prompt:="显示【是】和【否】2个按钮", Buttons:=vbYesNo
    MsgBox prompt:="显示【重试】和【取消】2个按钮", Buttons:=vbRetryCancel
End Sub

Sub msgbut()
    MsgBox prompt:="显示“关键消息”图标", Buttons:=vbCritical               'vbCritical       16       显示“关键消息”图标
    MsgBox prompt:="显示“警告询问”图标", Buttons:=vbQuestion               'vbQuestion       32       显示“警告询问”图标
    MsgBox prompt:="显示“警告消息”图标", Buttons:=vbExclamation            'vbExclamation    48       显示“警告消息”图标
    MsgBox prompt:="显示“通知消息”图标", Buttons:=vbInformation            'vbInformation    64       显示“通知消息”图标
End Sub

Sub msgbut()
    Dim yn As Integer
    yn = MsgBox(prompt:="是否在A1单元格输入100？", Buttons:=vbYesNo + vbQuestion)
    If yn = vbYes Then         '判断用户按下哪个按钮
        Range("A1").Value = 100
    End If
End Sub

yn = MsgBox(prompt:="是否在A1单元格输入100？", Buttons:=vbYesNo + vbQuestion + vbDefaultButton2) 'vbDefaultButton2 设置第二个按钮为缺省按钮，参数值也可以写为4+32+256或者292

'vbDefaultButton1           0              第一个按钮为缺省按钮
'vbDefaultButton2          256             第二个按钮为缺省按钮
'vbDefaultButton3          512             第三个按钮为缺省按钮
'vbDefaultButton4          768             第四个按钮为缺省按钮

'vbApplicationModal 0 应用程序强制返回；暂停执行应用程序，直到用户对消息框做出响应才继续工作
'vbSystemModal 4096 系统强制返回；暂停执行应用程序，直到用户对消息框做出响应才继续工作

'msgbox函数的返回值
'vbOK        1       单击【确定】按钮
'vbCancel    2       单击【取消】按钮
'vbAbort     3       单击【终止】按钮
'vbRetry     4       单击【重试】按钮
'vbIgnore    5       单击【忽略】按钮
'vbYes       6       单击【是】按钮
'vbNo        7       单击【否】按钮

Sub openfile()
    If Application.FindFile = True Then    '判断文件是否打开
        MsgBox "选择的文件已打开！"
    Else
        MsgBox "没有打开任何文件！"
    End If
End Sub

Sub getfile_1()
    Dim fil As String
    fil = Application.GetOpenFilename()   '将选中的文件名赋给变量fil
    If fil = "False" Then
        MsgBox "没有选择任何文件！"
        Exit Sub                         '退出程序
    Else
        Range("a1").Value = fil          '将文件名写入活动工作表的A1单元格
    End If
End Sub

Sub getfile()
    Dim fil As String
    fil = Application.GetOpenFilename(filefilter:="Excel 97-2003 工作簿(*.xls),*.xls") 'Excel 97-2003 工作簿(*.xls)是文件筛选条件，*.xls指定在对话框中显示的文件类型
    Range("A1").Value = fil      '将文件名写入A1单元格
End Sub

Sub getfile_3()
    Dim fil As String
    fil = Application.GetOpenFilename(filefilter:="Excel或Word 97-2003 文件(*.xls;*.doc),*.xls;*.doc")
    Range("A1").Value = fil      '将文件名写入A1单元格
End Sub

fil = Application.GetOpenFilename(filefilter:="Excel 97-2003 工作簿(*.xls),*.xls,Word 97-2003 文档(*.doc),*.doc")

Sub getfile4()
    Dim fil
    fil = Application.GetOpenFilename(filefilter:="Excel 97-2003 工作簿(*.xls),*.xls,Word 97-2003 文档(*.doc),*.doc", FilterIndex:=2, Title:="请选择文件", MultiSelect:=True)
    [A1].Resize(UBound(fil), 1) = Application.WorksheetFunction.Transpose(fil)
End Sub

Sub getsaveas()
    Dim fil As String, filename As String, filter As String, tle As String
    filename = "我要选择的文件"
    filter = "Excel 97-2003 工作簿(*.xls),*.xls,Word 97-2003 文档(*.doc),*.doc,文本文件(*.txt),*.txt"
    tle = "请选择需要的文件"
    '用变量做方法的参数
    fil = Application.GetSaveAsFilename(InitialFileName:=filename, filefilter:=filter, FilterIndex:=2, Title:=tle) 'InitialFileName指定显示的文件名，filefilter指定文件的筛选条

件，FilterIndex设置【保存类型】下拉列表中的第几项默认筛选条件，Title指定对话框的标题
Range("A1") = fil '把文件名写入A1单元格
End Sub

Sub getfolder()
    With Application.FileDialog(filedialogtype:=msoFileDialogFolderPicker)   'msoFileDialogFolderPicker参数只允许用户选择一个文件夹
        .InitialFileName = "D:\"         '设置D盘根目录为起始目录
        .Title = "请选择一个目录"        '设置对话框标题
        .Show                            '显示对话框
        If .SelectedItems.Count > 0 Then '判断是否选中了目录
            Range("A1").Value = .SelectedItems(1) '将选中的目录名及路径写进A1单元格
        End If
    End With
End Sub
'msoFileDialogFilePicker     允许选择一个文件
'msoFileDialogFolderPicker   允许选择一个文件夹
'msoFileDialogOpen           允许打开一个文件
'msoFileDialogSaveAs         允许保存一个文件

Sub xianshi()
Load 录入 '加载“录入”窗体
录入.Show '显示“录入”窗体
End Sub

Sub xianshi()
录入.Show '显示名称为“录入”的窗体
End Sub

Sub xianshi()
录入.Show vbModal '显示模式窗体
Range("A1") = "现在显示的是模式窗体！"
End Sub

Sub hidefrom()
录入.Hide '隐藏“录入”窗体
End Sub

Sub unloadfrom()
Unload 录入 '卸载“录入”窗体
End Sub

Private Sub userform_initialize()
'设置性别复合框的条目为“男”和“女”
性别.List = Array("男", "女")
End Sub

Private Sub 确定_click()
'判断信息是否输入完整
    If 姓名.Value = "" Or 性别.Value = "" Or 出生年月.Value = "" Then
        MsgBox "信息输入不完整，请重新输入！", vbExclamation, "错误提示"
        Exit Sub                                                            '退出执行程序
    End If
    Dim xrow As Integer
    xrow = Range("A1").CurrentRegion.Rows.Count + 1 '求第一条空行行号
    '将姓名、性别、出生年月写入第一条空行
    Cells(xrow, "A") = 姓名.Value
    Cells(xrow, "B") = 性别.Value
    Cells(xrow, "C") = 出生年月.Value
    '内容写入工作表后，将控件中的内容消除
    姓名.Value = ""
    性别.Value = ""
    出生年月.Value = ""
End Sub

Private Sub 退出_click()
Unload Me '卸载录入窗体 me指录入窗体，即代码所在的模块
End Sub

Application.Caption = "我的程序" '更改标题栏程序名称为“我的程序”

Sub menuhide()
    With Application.CommandBars(1)
        .Controls("文件(&F)").Visible = False    '隐藏“文件”菜单
        .Controls("编辑(&E)").Visible = False    '隐藏“编辑”菜单
        .Controls("视图(&V)").Visible = False    '隐藏“视图”菜单
        .Controls("插入(&I)").Visible = False    '隐藏“插入”菜单
        .Controls("格式(&O)").Visible = False    '隐藏“格式”菜单
        .Controls("工具(&T)").Visible = False    '隐藏“工具”菜单
        .Controls("数据(&D)").Visible = False    '隐藏“数据”菜单
        .Controls("窗口(&W)").Visible = False    '隐藏“窗口”菜单
        .Controls("帮助(&H)").Visible = False    '隐藏“帮助”菜单
    End With
End Sub

Sub menuhide()
    Dim i% '定义一个变量
    With Application.CommandBars(1)
        For i = 1 To .Controls.Count
            .Controls(i).Visible = False '隐藏第i个菜单
        Next
    End With
End Sub

Sub menuhide()
Application.CommandBars(1).Enabled = False '隐藏菜单栏
End Sub

Sub toolhide()
    '隐藏常用工具栏和格式工具栏
    With Application
        .CommandBars("standard").Visible = False       '隐藏常用工具栏
        .CommandBars("formatting").Visible = False     '隐藏格式工具栏
    End With
End Sub

Sub toolhide()
    Dim i%
    For i = 2 To Application.CommandBars.Count     '索引号从2开始，因为1是菜单栏
        Application.CommandBars (i), Enabled = False '隐藏所有工具栏 enabled，利用索引号引用对象，并设置对象的enabled属性值为false，如果想重新显示工具栏，将属性值设回true即可
    Next
End Sub

Sub windowset()
    With ActiveWindow
        .DisplayHeadings = False                 '隐藏行标和列标
        .DisplayHorizontalScrollBar = False      '隐藏行标和列标
        .DisplayVerticalScrollBar = False        '隐藏行标和列标
        .DisplayGridlines = False                '隐藏行标和列标
        .DisplayWorkbookTabs = False             '隐藏行标和列标
    End With
End Sub

Sub other()
    With Application
        .DisplayFormulaBar = False          '隐藏编辑栏
        .CommandBars.DisableAskAQuestionDropdown = True '隐藏帮助
        .CommandBars("ply").Enabled = False        '右键单击工作表标签后不显示菜单
        .CommandBars("cell").Enabled = False       '右键单击工作表区域后不显示菜单
        .DisplayStatusBar = False        '隐藏状态栏
        .ShowStartupDialog = False       '隐藏任务窗格
    End With
End Sub

Sub dengji()
    Dim xrow As Integer
    With Worksheets("调查结果")
        xrow = .[A1].CurrentRegion.Rows.Count + 1      '取得第一条空行行号
        .Cells(xrow, "A") = [d5]                       '写入学员ID
        '写入2到9题选择结果
        .Cells(xrow, "B").Resize(1, 16).Value = Application.WorksheetFunction.Transpose([j10:j25].Value)
        .Cells(xrow, "R").Value = [B67].Value    '写入学员对培训中心的建议
    End With
    Union([d5:e5], [j10:j25], [b67:g67]).ClearContents '清除调查问卷中原有答案
    MsgBox "已保存到“调查结果”工作表中！", vbInformation, "提示"
End Sub

Dim nrow As Long   '定义一个模块级的变量，让该模块
Private Sub cmdfind_click()    '单击“查询”按钮时运行程序
'判断按什么方式进行查找
    Dim col As Integer
    If findname.Value = True Then
        col = 7           '如果按身份证号查找，则查找第7列
    Else
        col = 1           '如果按职工编号查找，则查找第1列
    End If
    With Worksheets("职工档案")
        Dim rng As Range
        '在查找列查找输入的关键字
        Set rng = .Columns(col).Find(findtext.Value, lookat:=xlWhole)
        If Not rng Is Nothing Then    '判断是否找到内容匹配的单元格
            nrow = rng.Row            '取得查找到的单元格的行号
            Call findi                '运行findi子过程
        Else
            MsgBox "没有找到符合条件的记录！"
        End If
        findtext.Value = ""       '清除查找框中输入的数据
    End With
End Sub

Private Sub cmdadd_click()   '单击“新增”按钮时运行程序
    '判断在对话框中按下哪个按钮
    If MsgBox("确定在“职工档案”中添加该员工的记录吗？", vbQuestion + vbYesNo, "询问") = vbYes Then
    '取得第一条空行行号
        nrow = Worksheets("职工档案").Range("A1").CurrentRegion.Rows.Count + 1
        Call edit      '运行edit过程
    End If
End Sub

Private Sub cmddel_click()   '单击“删除”按钮时运行程序
    '判断在对话框中按下哪个按钮
    If MsgBox("确定将该员工信息移动到“删除”工作表中吗？", vbQuestion + vbYesNo, "询问") = vbYes Then
        '取得当前“职工编号”所在的行号
        nrow = Worksheets("职工档案").Range("A1:A65536").FING(Range("C7").Value, lookat:=xlWhole).Row
        '把记录复制到“删除”工作表中
        Worksheets("职工档案").Rows(nrow).Copy Worksheets("删除").Range("A65536").End(xlUp).Offset(1, 0)
        '删除该条记录
        Worksheets("职工档案").Cells(nrow, "A").EntireRow.Delete
    End If
End Sub

Private Sub cmdedit_click() '单击“修改”按钮时运行程序
    '判断在对话框中按下哪个按钮
    If MsgBox("确定修改“职工档案”中该员工的信息吗？", vbQuestion + vbYesNo, "询问") = vbYes Then
        '取得当前“职工编号”所在的行号
        nrow = Worksheets("职工档案").Range("A1:A65536").FING(Range("C7").Value, lookat:=xlWhole).Row
        Call edit         '运行edit过程
    End If
End Sub

Private Sub cmdfirst_click() '单击“第一条”按钮时运行程序
nrow = 2 '行号等于2
Call fini '运行findi子过程
End Sub

Private Sub cmdend_click() '单击“最后一条”按钮时运行程序
'取得最后一条记录的行号
nrow = Worksheets("职工档案").Range("A1").CurrentRegion.Rows.Count
Call fini '运行findi子过程
End Sub

Private Sub cmdformer_click() '单击“上一条”按钮时运行程序
'取得当前“职工编号”所在行的上一行行号
nrow = Worksheets("职工档案").Range("A2:A65536").FING(Range("C7").Value, lookat:=xlWhole).Row - 1
Call findi '运行findi过程
End Sub

Private Sub cmdnext_click() '单击“下一条”按钮时运行程序
'取得当前“职工编号”所在行的下一行行号
nrow = Worksheets("职工档案").Range("A2:A65536").FING(Range("C7").Value, lookat:=xlWhole).Row + 1
Call findi '运行findi过程
End Sub

Sub findi()   '子过程
'将“职工档案”中第nrow行的记录写入“查询”表中
    With Worksheets("职工档案")
        Range("C7:E7").Value = .Range(.Cells(nrow, 1), .Cells(nrow, 3)).Value
        Range("C10:E10").Value = .Range(.Cells(nrow, 4), .Cells(nrow, 6)).Value
        Range("C13").Value = .Cells(nrow, 7).Value
        Range("E13").Value = .Cells(nrow, 8).Value
        Range("C16:E16").Value = .Range(.Cells(nrow, 9), .Cells(nrow, 11)).Value
        Range("C19").Value = .Cells(nrow, 12).Value
    End With
End Sub

Sub edit()   '子过程
    '将查询表中的记录添加到第nrow行中
    With Worksheets("职工档案")
        .Cells(nrow, "A").Resize(1, 3) = Range("C7:E7").Value
        .Cells(nrow, "D").Resize(1, 3) = Range("C10:E10").Value
        .Cells(nrow, 7).Value = Range("C13").Value
        .Cells(nrow, 8).Value = Range("E13").Value
        .Cells(nrow, 9).Resize(1, 3).Value = Range("C16:E16").Value
        .Cells(nrow, 12).Value = Range("C19").Value
    End With
End Sub

Private Sub workbook_open()
Application.Visible = False '隐藏EXCEL程序界面
denglu.Show '显示登陆窗体界面
End Sub

Sub namevisible() '隐藏名称
Names("username").Visible = False
Names("userword").Visible = False
End Sub

Private Sub cmdok_click()     '单击“确定”按钮的时候执行过程
    Application.ScreenUpdating = False       '关闭屏幕更新
    Static i As Integer                     '声明一个变量
    '判断用户名和密码是否输入正确
    If CStr(user.Value) = Right(Names("username").RefersTo, Len(Names(UserName).RefersTo) - 1) And CStr(Password.Value) = Right(Names("userword").RefersTo, Len(Names

("userword").RefersTo) - 1) Then
        Unload Me    '关闭登陆窗体
        Application.Visible = True      '显示EXCEL界面
    Else
        i = i + 1 '密码或用户输入错误一次，变量i加1
        If i = 3 Then     '如果输错3次执行if到else间的语句
            MsgBox "对不起，你无权打开工作簿！", vbInformation, "提示"
                ThisWorkbook.Close savechanges:=False '关闭当前工作簿，不保存更改
        Else
            MsgBox "输入错误，你还有" & (3 - i) & "次输入机会。", vbExclamation, "提示"
                user.Value = ""      '清除文字框中的用户名
            Password.Value = ""      '清除文字框中的密码
        End If
    End If
    Application.ScreenUpdating = True   '开启屏幕更新
End Sub

Private Sub cmdcancel_click()    '当单击“退出”按钮时执行过程
    Unload Me   '关闭登陆窗体
    ThisWorkbook.Close savechanges:=False   '关闭当前工作簿，不保存修改
End Sub

Private Sub userset_click()   '单击“更改用户名”按钮时运行过程
    Dim old As String, new1 As String, new2 As String
    old = InputBox("请输入原用户名：", "提示")
    new1 = InputBox("请输入新用户名：", "提示")
    new2 = InputBox("请再次输入新用户名：", "提示")
    If old <> "" And new1 <> "" Then     '判断输入的用户名是否为空
        '判断新旧用户名是否输入正确
        If old = Right(Names("username").RefersTo, Len(Names("username").RefersTo) - 1) And new1 = new2 Then
            Names("username").RefersTo = "=" & new1 '修改名称值
            ThisWorkbook.Save      '报存更改
            MsgBox "用户名修改完成，下次登录请使用新用户名！", vbiformation, "提示"
        Else
            MsgBox "输入错误，修改没有完成！", vbCritical, "错误"
        End If
    Else
        MsgBox "用户名不能为空！", vbCritical, "错误"
    End If
End Sub

Private Sub passwwordset_click()     '当单击“更改密码”按钮时运行过程
    Dim old As String, new1 As String, new2 As String
    old = InputBox("请输入原密码：", "提示")
    new1 = InputBox("请输入新密码：", "提示")
    new2 = InputBox("请再次输入密码：", "提示")
    If old <> "" And new1 <> "" Then     '判断输入的密码是否为空
        '判断新旧密码是否输入正确
        If old = Right(Names("userword").RefersTo, Len(Names("userword").RefersTo) - 1) And new1 = new2 Then
            Names("userword").RefersTo = "=" & new1 '修改名称值
            ThisWorkbook.Save      '报存更改
            MsgBox "用户名修改完成，下次登录请使用新密码！", vbiformation, "提示"
        Else
            MsgBox "输入错误，修改没有完成！", vbCritical, "错误"
        End If
    Else
        MsgBox "密码不能为空！", vbCritical, "错误"
    End If
End Sub

Private Sub userform_queryclose(cancel As Integer, closemode As Integer)
'当单击窗体右上角关闭按钮时运行程序
If closemode <> 1 Then cancel = 1
End Sub

Sub bycy()
If Range("A1").Value > 0 Then
MsgBox "A1单元格的数是正数。"
End Sub

Sub yxscw()
Kill ThisWorkbook.FullName '删除代码坐在的工作簿文件
End Sub

Sub ljcy()
    Dim i As Integer
    For i = 1 To 10
        Cells(1, 1).Value = i   '事实上，数据永远都被写入A1单元格里
    Next
End Sub

Sub stoptest()
    Dim i As Long
    i = 1
    Do Until i < 1
        i = i + 1
    Loop
End Sub
'按ESC或ctrl+break会中断运行

Sub test()
    Dim i As Integer
    For i = 1 To 100 Step 2
        Cells(i, "A").Value = i
        Debug.Print "i=" & i   '将表达式的值输出到立即窗口中
End Sub

Sub test()
    On Error GoTo a                     '如果发生错误，则转到标签a的语句行
    Worksheets("abc").Select            '如果工作表中没有abc工作表，程序会发生错误
    Exit Sub
a:     MsgBox "没有要选择的工作表！"
End Sub

Sub test()
    On Error Resume Next                     '忽略该行代码之后出现的运行时错误
    Worksheets("abc").Select
    Exit Sub                    '退出程序
    MsgBox "没有要选择的工作表！"
End Sub

Sub test()
    On Error Resume Next                     '忽略该行代码之后出现的运行时错误
    Worksheets("abc").Select                 '如果工作表中没有abc工作表，程序会发生错误
    On Error GoTo 0                          '关闭错误捕捉
    Worksheets("def").Select                 '如果工作簿中没有def工作表，程序会出错
    Exit Sub                                 '退出程序
a:        MsgBox "没有要选择的工作表！"
End Sub
'因为程序开始时已经设置了忽略程序中的运行时错误，但因为关闭了错误捕捉，所以 On Error GoTo 0 代码后发生的错误将不会被忽略

Sub test()
    Dim rng As Range
    Set rng = Worksheets(1).Range("A1:D100")
    rng = 200
    Set rng = Nothing    '将rng变量与worksheets(1).range("A1:D100")分离开
End Sub
'nothing被赋值给一个对象变量后，该变量不再引用任何对象。

Sub test()
    ThisWorkbook.Worksheets(1).Range("A1").Clear
    ThisWorkbook.Worksheets(1).Range("A1").Value = "excel home"
    ThisWorkbook.Worksheets(1).Range("A1").Font.Name = "宋体"
    ThisWorkbook.Worksheets(1).Range("A1").Font.Size = 16
    ThisWorkbook.Worksheets(1).Range("A1").Font.Bold = True
    ThisWorkbook.Worksheets(1).Range("A1").Font.ColorIndex = 3
End Sub

Sub withtest()
    With ThisWorkbook.Worksheets(1).Range("A1")
        .Clear
        .Value = "excel home"
        .Font.Name = "宋体"
        .Font.Size = 16
        .Font.Bold = True
        .Font.ColorIndex = 3
    End With
End Sub

Sub withtest2()
    With ThisWorkbook.Worksheets(1).Range("A1")
        .Clear
        .Value = "excel home"
        With .Font
            .Name = "宋体"
            .Size = 16
            .Bold = True
            .ColorIndex = 3
        End With
    End With
End Sub

Sub objecttest()
    Dim rng As Range
    Set rng = ThisWorkbook.Worksheets(1).Range("A1")
    rng.Clear
    rng.Value = "excel home"
    rng.Font.Name = "宋体"
    rng.Font.Size = 16
    rng.Font.Bold = True
    rng.Font.ColorIndex = 3
End Sub

Sub objecttest_2()
    Dim rng As Range
    Set rng = ThisWorkbook.Worksheets(1).Range("A1")
    With rng
        .Clear
        .Value = "excel home"
        .Font.Name = "宋体"
        .Font.Size = 16
        .Font.Bold = True
        .Font.ColorIndex = 3
    End With
End Sub

Sub macrol()
    Range("A1").Select
    Selection.Copy
    Sheets("sheet2").Select
    Range("B1").Select
    ActiveSheet.Paste
    Sheets("sheet1").Select
End Sub

Sub macro2()
Range("A1").Copy Sheets("sheet2").Range("B1")
End Sub

Sub inputtxt()
    Dim start As Double
    start = Timer           '取得从午夜开始到程序运行时经过的秒数
    Dim i As Long
    For i = 1 To 65536
        Cells(i, "A").Value = i
    Next
    MsgBox "程序运行的时间约是" & Format(Timer - start, "0.00") & "秒"
End Sub

Sub inputarr()      '运行效率更高
    Dim start As Double
    start = Timer           '取得从午夜开始到程序运行时经过的秒数
    Dim i As Long, arr(1 To 65536) As Long
    For i = 1 To 65536
        arr(i) = i
    Next
    Range("A1:A65536").Value = Application.WorksheetFunction.Transpose(arr)
    MsgBox "程序运行的时间约是" & Format(Timer - start, "0.00") & "秒"
End Sub

Sub inputarr_2()
    Dim start As Double
    start = Timer           '取得从午夜开始到程序运行时经过的秒数
    Dim i As Long, arr(1 To 65536, 1 To 1) As Long
    For i = 1 To 65536
        arr(i, 1) = i
    Next
    Range("A1:A65536").Value = arr
    MsgBox "程序运行的时间约是" & Format(Timer - start, "0.00") & "秒"
End Sub

EXCEL VBA 备忘录相关推荐

Excel VBA 教程
https://www.w3cschool.cn/excelvba/ Excel VBA 编程教程 https://www.yiibai.com/vba VBA教程 http://www.acc ...
Excel VBA附合导线平差自动计算表
这是6,7年前做的一个excel vba自动计算附合导线平差的表格. 对于做测绘的朋友来说,附合导线平差是最基础的技能,目前来说,能平差的软件和工具也很多,像南方的平差易,科傻平差.清华三维平差等,但 ...
编写高效Excel VBA代码的最佳实践(一)
很多Excel VBA文章和图书都介绍过如何优化VBA代码,使代码运行得更快.下面搜集了一些使Excel VBA代码运行更快的技术和技巧,基本上都是实践经验的总结.如果您还有其它优化Excel VBA ...
如何避免在Excel VBA中使用选择
本文翻译自:How to avoid using Select in Excel VBA I've heard much about the understandable abhorrence of ...
【090】Excel VBA 基础
Excel Object Model: Application Object (Excel): Stab Me!!! Font Object (Excel): Stab Me!!! Worksheet ...
cxgrid 行合并单元格_【Excel VBA】如何批量撤销合并单元格？
周末好,之前我们分享了批量合并单元格的VBA小代码,链接参考: [Excel VBA]如何批量合并相同值单元格? 天下大势合久必分.分久必合.分分合合合合分分又合合合再分分分又又合合合合合合合---- ...
Excel VBA中的等价(Eqv)和蕴含(Imp)
在一般的编程语言中,逻辑运算只有四个 - Not - And - Or - Xor 但在Excel VBA中,还有 - Eqv 逻辑等价 - Imp 逻辑蕴含他们的真值表如下现给逻辑等价Eqv和逻 ...
Excel VBA开发中数字签名的管理
Excel 禁用无数字签署的宏网上下载的Excel文件可能含有宏病毒,因此打开Excel文件时最好不要轻易启动宏,同时为了不让"启动宏"的提示每次出现,可以在Excel设置中提高 ...
zemax 宏怎么编写数组_编写Excel VBA程序的10个技巧
学习Excel技术,关注微信公众号: excelperfect 学会一些有趣的技巧或想法,能够有效地提高ExcelVBA编程水平.下面是chandoo.org总结的编写Excel VBA程序的10个技 ...

EXCEL VBA 备忘录

EXCEL VBA 备忘录相关推荐

最新文章

热门文章