事件

事件可以看成是人的反射系统，有感受器-控制逻辑-效应器三部分组成，excel中的感受器，效应器往往是控件或者单元格，注意好触发条件和控制逻辑是学好事件的基础

一、工作表事件

案例:进入sheet自动刷新

经过录制宏我们已经知道刷新的代码为
activesheet.refreshall
1.只需要进入VBE-worksheet-activate
2.copy代码即可
意思是worksheet被activate时候
执行代码activesheet.refreshall

以上我们已经简单测试了activate事件

---

接下来我们可以试试其他事件比如，单元格改变值事件-change

自动筛选的实现

column("k","o").clearcontents'清楚内容
Range(E17).Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$764").AutoFilter Field:=7,Criteria1:="x" 'x为条件格式中的值
Range("A1").Select
Range(Selection, Selection.End(xdToRight)).Select
Range(Selection, Selection.End(xdDown)).Select  '全选
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
Range("F1").Select
Application.CutCopyMode = False
Selection.AutoFilter

要实现对指定单元格处理则需要设置target参数，例如target.address="$i$2"

如果使用了change里面也有单元格操作，就形成递归死循环，所以还是需要以上控制的

application.enableevent=False 如果在事件里面调用可以在本事件执行时屏蔽其他事件，所以也就没有了死循环了，但记得最后打开，不然以后就没事件了

接下来我们可以尝试选区改变事件-Selection_Change

聚光灯效果的实现
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.Pattern = xlNone
Target.EntireColumn.Interior.Color = vbGreen
Target.EntireRow.Interior.Color = vbGreen
End Sub

二、工作簿事件

案例1:实现输入人名显示对应的表，其他表不显示

使用workbook-open动作

输入框inputbox

dim a as string
a=inputbox "message" 'a中得到了内容
dim sht as worksheet
for each sht in Sheets
	if sht.name<>"目录"then
		sht.visible=xlsheethidden '基本隐藏  PS：xlsheetveryhidden取消隐藏看不到
	endif
next
if a="张三"then
	sheets("张三").visible=xlsheetbisible
else if a="李四"then
	sheets("李四").visible=xlsheetbisible
endif

案例2:实现关闭时自动保存

使用workbook-beforeclose动作

thisworkbook.save

案例3:实现关闭时自动保存

使用workbook-newsheet动作

Private Sub Workbook_NewSheet(ByVal Sh As Object)
application.displayalert=False
sh.delete
application.displayalert=True
End Sub

案例4:禁止打印工作表

使用workbook-beforeprint动作

Private Sub Workbook_BeforePrint(Cancel As Boolean)
msgbox "不可打印"
cancel=true
End Sub

案例5:保存时另存备份

使用workbook-beforesave动作 防止顺手保存了不想保存的东西要回原来的备份

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
this workbook.savecopyas "d:/..../"&Format(now,"yyyymmddhhmmss")&".xlam"    'saveas是换个地方保存 savecopyas'    
End Sub

三、VBA函数

1. Excel通用函数的使用

通过worksheetfunction.(sum/average....)即可调用excel中的函数

2. VBA专有函数的使用

通过vba.函数名 即可调用excel中的函数

Sub tt()
Dim arr, x, k, j
For j = 1 To 4
	arr = VBA.Split(Range(Ta”& j),Chr(10))   'chr(10)是换行符，当很多数据被放在一个单元格中使用，chr把int转为ascii
	For x = LBound(arr)To UBound(arr) '0开始
		k = k +1
		Range("b & k) = arr(x)
	Next
Next
End Sub

至此我们可以实现把指定文件夹下的工作簿中的所有工作表整合到当前工作簿中

Sub 合并文件()
Application.ScreenUpdating = False
Dim filename As String
Dim wb As Workbook
Dim sht As Worksheet
Dim x As Integer
Dim str As String
str = inputBox("请输入要合并的文件所在的文件夹")
filename = Dir(str &"\*.xls*")  ’Dir可以选出所有符合excel文件
For x = 1 To 100
	'Range("a"& x) = filename
	Set wb = Workbooks.Open(str & \” & filename)
	For Each sht In wb.Sheets
		sht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
		ActiveSheet.Name = VBA.split(wb.Name,".)(0) & sht.Name   'wb.name可能会很长要注意
	Next
wb.Close
filename=Dir
if filename="" then
exit for
next
end sub

合并所有工作簿内容到当前工作簿的当前工作表

法一:
Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
	If MyName <> AWbName Then
		Set Wb = Workbooks.Open(MyPath & "\" & MyName)
		Num = Num + 1
		With Workbooks(1).ActiveSheet
			.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
			For G = 1 To Sheets.Count
				Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
			Next
			WbN = WbN & Chr(13) & Wb.Name
			Wb.Close False
		End With
	End If
	MyName = Dir
Loop
	Range("B1").Select
	Application.ScreenUpdating = True
	MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

法二:
Sub 合并目录所有工作簿全部工作表()
Dim MP, MN, AW, Wbn, wn
Dim Wb As Workbook
Dim Num As Integer
Dim i, a, b, d, c, e
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MP = ActiveWorkbook.Path
MN = Dir(MP & "\" & "*.xls")
AW = ActiveWorkbook.Name
Num = 0
e = 1
Do While MN <> ""
	If MN <> AW Then
	Set Wb = Workbooks.Open(MP & "\" & MN)
	a = a + 1
		With Workbooks(1).ActiveSheet
	For i = 1 To Sheets.Count
	If Sheets(i).Range("a1") <> "" Then
		Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)
		d = Wb.Sheets(i).UsedRange.Columns.Count
		c = Wb.Sheets(i).UsedRange.Rows.Count - 1
		wn = Wb.Sheets(i).Name
		.Cells(1, d + 1) = "表名"
		.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn
		e = e + c
		Wb.Sheets(i).Range("a2").Resize(c, d).Copy
		.Cells(.Range("a1048576").End(xlUp).Row + 1, 1)
	End If
Next
Wbn = Wbn & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MN = Dir
Loop
Range("a1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "共合并了" & a & "个工作薄下全部工作表。如下：" & Chr(13) & Wbn, vbInformation, "提示"
End Sub

thisworkbook就是本工作簿,对于本工作簿可以使用path方法返回当前文件夹

mkdir批量新建文件夹

mkdir "path"

批量修改文件名(按照excel)

name A as B 把文件名A改为B

可能名字会很长 _是vba换行符

四、让宏扩张使用

1.将文件保存为.xla加载宏文件

2.自定义功能区-新建选项卡-新建组

3.把宏放入组即可

五 其他操作

VBA与打印配置

With ActiveSheet.PageSetup 
.PrintTitleRows = "$1:$1" '设置打印标题行
.fittopagewidth = 1	'打印在1页
.zoom =x 'x为压缩比在设置打印宽度地方可以找到

VBA Inputbox

Sub 合并居中()
On Error GoTo 1 '1是标记使用goto语句，出错就结束
Dim rng As Range
Set rng = Application.InputBox("请选择要合并的单元格区域","合并居中", "a1"... .，8)
with rng
	.Merge     '单元格合并
	.HorizontalAlignment = xlCenter   '水平居中
	.VerticalAlignment = xlCenter   '垂直居中
	End With
1:
End Sub

VBA字典

性质:由键-值对组成，key不可以重复，value可以

使用VBE-工具-引用-Microsoft-scripting-runtime

Dim dic As New Dictionary
dic.Add"张三",98
dic.Add"李四",80
dic.Add"王五",60
dic.keys '所有的键
dic.values '所有的值
dic.count	'数量
dic(key)=value '添加键值对的方式，会覆盖，也就是后面遇到了同样的key不报错但是覆盖了
Range("e2").Resize(dic.Count, 1) = Application.Transpose(dic.Keys)

字典在使用时要适当注意行列，不能直接调用一般key是横着的，value是竖着的，如果要竖着显示key则需要application.transpose​

主要应用就是把一列/行赋给字典的key可以用来筛不重复值

​