VBA学习笔记
这是一个学习VBA编程的学习笔记。
一.介绍
Visual Basic for Applications（VBA）是Visual Basic的一种宏语言，主要能用来扩展Windows的应用程式功能，特别是Microsoft Office软件。
Visual
Basic for Applications（简称VBA）是新一代标准宏语言，是基于Visual Basic for Windows
发展而来的。它与传统的宏语言不同，传统的宏语言不具有高级语言的特征，没有面向对象的程序设计概念和方法。而VBA
提供了面向对象的程序设计方法，提供了相当完整的程序设计语言。
区别：
- VB是设计用于创建标准的应用程序,而VBA是使已有的应用程序(EXCEL等)自动化
- VB具有自己的开发环境,而VBA必须寄生于已有的应用程序.
- 要运行VB开发的应用程序,用户不必安装VB,因为VB开发出的应用程序是可执行文件(*.EXE),而VBA开发的程序必须依赖于它的父应用程序,例如EXCEL.
- VBA是VB的一个子集。
二. 使用手册
2.1. 如何在Excel2010中开始使用VBA？
“开发工具”选项卡
所有 Office 2010 应用程序都使用功能区。功能区中有一个“开发工具”选项卡，在此可以访问 Visual Basic 编辑器和其他开发人员工具。
由于 Office 2010 在默认情况下不显示“开发工具”选项卡，因此必须使用以下过程启用该选项卡：
启用“开发工具”选项卡
-
在“文件”选项卡上，选择“选项”打开“Excel 选项”对话框。
-
单击该对话框左侧的“自定义功能区”。
-
在该对话框左侧的“从下列位置选择命令”下，选择“常用命令”。
-
在该对话框右侧的“自定义功能区”下，选择“主选项卡”，然后选中“开发工具”复选框。
-
单击“确定”。
在 Excel 显示“开发工具”选项卡之后，注意选项卡上“Visual Basic”、“宏”和“宏安全性”按钮的位置。
2.2. 如何使用VBA编辑器进行编程？
VBA 是一种功能齐全的编程语言，并具有一个相应的功能齐全的编程环境。本文只介绍那些您刚开始编程所使用的工具，而不介绍 Visual Basic 编辑器中的大部分工具。出于这个原因，请关闭 Visual Basic 编辑器左侧的“属性”窗口，并忽略在代码上方显示的两个下拉列表。
1. 单击“开发工具”选项卡上的“宏”按钮。
2. 在随后出现的“宏”对话框中，在“宏名称”下键入 Hello。
3. 单击“创建”按钮打开 Visual Basic 编辑器，其中包含已键入的新宏的大纲。
4.Visual Basic 编辑器包含下列代码。
Sub Hello() MsgBox ("Hello, world!") End Sub
5. 然后点击上面的运行按钮，运行结果
注意：如果当您打开一个包含宏的工作簿时，在功能区和工作表之间出现“安全警告: 宏已被禁用”条，则可单击“启用内容”按钮来启用宏。
此外，作为一种安全措施，您不能以默认的 Excel 文件格式 (.xlsx) 保存宏；而必须将宏保存在具有一个特殊扩展名 .xlsm 的文件中。
三. 语法说明
3.1 数据类型
VBA共有12种数据类型，具体见下表，此外用户还可以根据以下类型用Type自定义数据类型。
3.2 变量和常量的定义
- VBA允许使用未定义的变量，默认是变体变量。
- 在模块通用说明部份，加入 Option Explicit 语句可以强迫用户进行变量定义。
- 变量定义语句及变量作用域
Dim 变量 as 类型 '定义为局部变量，如 Dim xyz as integer
Private 变量 as 类型 '定义为私有变量，如 Private xyz as byte
Public 变量 as 类型 '定义为公有变量，如 Public xyz as single
Global 变量 as 类型 '定义为全局变量，如 Globlal xyz as date
Static 变量 as 类型 '定义为静态变量，如 Static xyz as double
一般变量作用域的原则是，那部份定义就在那部份起作用，模块中定义则在该模块那作用。
4. 常量为变量的一种特例，用Const定义，且定义时赋值，程序中不能改变值，作用域也如同变量作用域。
如下定义：Const Pi=3.1415926 as single
注意：其中dim是dimension的缩写，表示为该变量在内存中需要分配的空间
3.3 数组
数组是包含相同数据类型的一组变量的集合，对数组中的单个变量引用通过数组索引下标进行。在内存中表现为一个连续的内存块，必须用Global或Dim语句来定义。定义规则如下：
Dim 数组名([lower to ]upper [, [lower to ]upper, ….]) as type ;
除了以上固定数组外，VBA还有一种功能强大的动态数组，定义时无大小维数声明；在程序中再利用Redim语句来重新改变数组大小，原来数组内容可以通过加preserve关键字来保留。如下例：
Dim array1() as double Redim array1(5) array1(3)=250 Redim preserve array1(5,10)
3.4 过程语句
过程分为判断和循环两种
3.4.1 判断语句：
1. If…Then…Else语句
或者，可以使用块形式的语法：
If condition Then [statements] [ElseIf condition-n Then [elseifstatements] ... [Else [elsestatements]] End If
2）Select Case…Case…End Case语句
Select Case Pid Case “A101” Price=200 Case “A102” Price=300 Case Else Price=900 End Case
3）Choose 函数
choose(index, choce-1,choice-2,…,choice-n)，可以用来选择自变量串列中的一个值，并将其返回，index 必要参数，数值表达式或字段，它的运算结果是一个数值，且界于 1 和可选择的项目数之间。choice 必要参数，Variant表达式，包含可选择项目的其中之一。如：
GetChoice = Choose(Ind, "Speedy", "United", "Federal")
4）Switch函数
switch函数和Choose函数类似，但它是以两个一组的方式返回所要的值，在串列中，最先为TRUE的值会被返回。 expr 必要参数，要加以计算的 Variant 表达式。value 必要参数。如果相关的表达式为 True，则返回此部分的数值或表达式，没有一个表达式为 True，Switch 会返回一个 Null值。
Switch(expr-1, value-1[, expr-2, value-2 _ [, expr-n,value-n]])
3.4.2. 循环语句
1）For Next语句 以指定次数来重复执行一组语句
For counter = start To end [Step step] ' step 缺省值为1 [statements]Next [counter]
2）For Each…Next语句 主要功能是对一个数组或集合对象进行，让所有元素重复执行一次语句
For Each element In group Statements Next [element]
如1：
For Each rang2 In range1 With range2.interior .colorindex=6 .pattern=xlSolid End with Next
3）Do…loop语句 在条件为true时，重复执行区块命令
Do {while |until} condition' while 为当型循环，until为直到型循环，顾名思义，不多说啦 Statements Exit do Statements Loop
3.5 过程和函数
过程是构成程序的一个模块，往往用来完成一个相对独立的功能。过程可以使程序更清晰、更具结构性。VBA具有四种过程：Sub 过程、Function函数、Property属性过程和Event事件过程。
Sub过程：
Sub 过程的参数有两种传递方式：按值传递(ByVal)和按地址传递(ByRef)。如下例：
Sub password (ByVal x as integer, ByRef y as integer) If y=100 then y=x+y else y=x-y x=x+100 End sub Sub call_password ()
Dim x1 as integer Dim y1 as integer x1=12 y1=100 Call password (x1,y1) ‘调用过程方式：1. Call 过程名(参数1, 参数2…) ; 2. 过程名参数1, 参数2… debug.print x1,y1 ‘结果是12、112，y1按地址传递改变了值，而x1按值传递，未改变原值 End sub
Function函数：
函数实际是实现一种映射，它通过一定的映射规则，完成运算并返回结果。参数传递也两种：按值传递(ByVal)和按地址传递(ByRef)。如下例：
Function password(ByVal x as integer, byref y as integer) as boolean If y=100 then y=x+y else y=x-y x=x+100 if y=150 then password=true else password=false End Function Sub call_password () Dim x1 as integer Dim y1 as integer x1=12 y1=100 if password then ‘调用函数：1. 作为一个表达式放在=右端 ; 2. 作为参数使用 debug.print x1
end if End sub
3.6 补充
在上面一例中用到了 With…End With 语句，目的是省去对象多次调用，加快速度；语法为：
With object [statements] End With
四. 具体实例
1 Option Explicit 2 3 '''''''''''''''''''''''''''''''''''''''''''''' 4 'this is created by luquanhong@gmail.com 5 'if you have any problem, please contact me 6 '''''''''''''''''''''''''''''''''''''''''''''' 7 8 '调用系统中安装的解压缩工具来解压当前目录及子目录下的所有压缩文件 9 Private Function discompressFiles(Path As String, filetype As String) 10 11 Dim result 12 Dim rarString As String 13 Dim rarStringRAR As String 14 Dim Files() As String '文件路径 15 Dim Folder() As String '文件夹路径 16 17 '请在这里修改WinRAR安装路径！！！！！！ 18 rarString = "C:\Program Files (X86)\WinRAR\WinRAR.exe" 19 20 If Len(Dir(rarString)) = 0 Then 21 MsgBox "请确认你安装了WinRAR程序，或者设置了正确的路径", 16, "退出" 22 Exit Function 23 End If 24 25 Dim a, b, c As Long 26 Dim sPath As String 27 If Right(Path, 1) <> "\" Then Path = Path & "\" 28 29 sPath = Dir(Path & filetype) '查找第一个文件 30 31 Do While Len(sPath) '循环到没有文件为止 32 a = a + 1 33 ReDim Preserve Files(1 To a) 34 Files(a) = Path & sPath '将文件目录和文件名组合,并存放到数组中 35 36 '解压所有的该类型文件 37 rarStringRAR = rarString & " x " & "-Y " & Path & sPath & " " & Path 38 'Debug.Print "rar rarString " & rarStringRAR 39 result = Shell(rarStringRAR, vbHide) 40 41 sPath = Dir '查找下一个文件 42 'DoEvents '让出控制权 43 Loop 44 45 sPath = Dir(Path & "\", vbDirectory) '查找第一个文件夹 46 47 Do While Len(sPath) '循环到没有文件夹为止 48 49 If Left(sPath, 1) <> "." Then '为了防止重复查找 50 If GetAttr(Path & "\" & sPath) And vbDirectory Then '如果是文件夹则。。。。。。 51 b = b + 1 52 ReDim Preserve Folder(1 To b) 53 Folder(b) = Path & sPath & "\" '将目录和文件夹名称组合形成新的目录,并存放到数组中 54 End If 55 End If 56 57 sPath = Dir '查找下一个文件夹 58 59 DoEvents '让出控制权 60 Loop 61 62 For c = 1 To b '使用递归方法，遍历所有目录 63 discompressFiles Folder(c), filetype 64 Next 65 66 End Function 67 68 69 '将查找到的所有文件,过滤掉压缩类型文件后，存入对于的Excel表格中 70 Private Sub GetFolderFile(ByVal nPath As String, ByRef iCount As Long, count As Integer) 71 72 Dim iFileSys 73 Dim filetype As String 74 Dim iFile As Files, gFile As File 75 Dim iFolder As Folder, sFolder As Folders, nFolder As Folder 76 77 Set iFileSys = CreateObject("Scripting.FileSystemObject") 78 Set iFolder = iFileSys.GetFolder(nPath) 79 Set sFolder = iFolder.SubFolders 80 Set iFile = iFolder.Files 81 82 With ActiveSheet 83 For Each gFile In iFile 84 ' .Hyperlinks.Add anchor:=.Cells(iCount, 1), Address:=gFile.path, TextToDisplay:=gFile.Name 85 86 '过滤掉所有压缩文件 87 filetype = Mid(gFile.Name, InStr(gFile.Name, ".") + 1) 88 If filetype = "zip" Or filetype = "rar" Then 89 Debug.Print "filter" 90 GoTo step1 91 End If 92 93 .Cells(count, iCount) = gFile.Name 94 95 iCount = iCount + 1 96 step1: 97 Next 98 End With 99 100 '递归遍历所有子文件夹 101 For Each nFolder In sFolder 102 Call GetFolderFile(nFolder.Path, iCount, count) 103 Next 104 End Sub 105 106 107 '主程序 108 Sub DealWithExcel() 109 110 Dim i, j, count As Integer 111 Dim myDir As String 112 Dim strTargetDir As String 113 Dim strTargetDir1 As String 114 Dim strSubDirs As String 115 Dim strDay() As String 116 Dim strCompany() As String 117 118 '清除Excel表 119 Columns("A:CA").Clear 120 121 count = 0 122 123 '选择需要执行宏的文件夹，获得文件夹名strDir 124 With Application.FileDialog(msoFileDialogFolderPicker) 125 .Show 126 If .SelectedItems.count = 0 Then Exit Sub 127 strTargetDir = .SelectedItems(1) 128 End With 129 130 myDir = Mid(strTargetDir, InStrRev(strTargetDir, "\") + 1) 131 132 '如果可以的话，这里可以做一个目标文件夹的检查，缺省不作处理 133 If Len(myDir) <> 6 Or VBA.IsNumeric(myDir) = False Then 134 MsgBox "这里只针对固定格式文件夹，比如：201310", 16, "退出" 135 Exit Sub 136 End If 137 138 139 If Right(strTargetDir, 1) <> "\" Then strTargetDir = strTargetDir & "\" 140 141 '处理zip格式的压缩文件 142 '解压两次，防止压缩文件中还包含有压缩文件的情况出现 143 For i = 0 To 2 144 discompressFiles strTargetDir, "*.zip" 145 Next i 146 147 '处理rar格式的压缩文件 148 '解压两次，防止压缩文件中还包含有压缩文件的情况出现 149 For i = 0 To 2 150 discompressFiles strTargetDir, "*.rar" 151 Next i 152 153 154 Debug.Print strTargetDir 155 '开始读取文件 156 strSubDirs = Dir(strTargetDir, vbDirectory) 157 'Debug.Print strSubDirs 158 159 i = 0 160 161 '读取目标目录下的所有目录 162 '根据规则，这里将读取到的将是每天的文件夹 163 Do While strSubDirs <> "" 164 On Error Resume Next 165 166 If strSubDirs <> ThisWorkbook.Name And strSubDirs <> "." And strSubDirs <> ".." Then '忽略哪些隐藏系统文件夹 167 168 If (GetAttr(strTargetDir & strSubDirs) And vbDirectory) = vbDirectory Then 'if foler 169 170 'Debug.Print "it is directory " & strSubDirs & " i " & i 171 ReDim Preserve strDay(i) As String 172 strDay(i) = strSubDirs 173 'Debug.Print "strDay" & i & " "; strDay(i) 174 175 i = i + 1 176 177 Else 'if file 178 Debug.Print "it not a directory" 179 End If 180 End If 181 182 strSubDirs = Dir 183 184 Loop 185 186 'Debug.Print "UBound(strDay):" & UBound(strDay) 187 188 '遍历日目录下的所有单位目录 189 For i = 1 To UBound(strDay) + 1 190 191 '处理每天的文件时，需要清空这个变量和数组 192 j = 0 193 Erase strCompany 194 ReDim Preserve strCompany(0) As String 195 196 'Debug.Print strDay(i - 1) 197 strTargetDir1 = strTargetDir & strDay(i - 1) & "\" 198 strSubDirs = Dir(strTargetDir1, vbDirectory) 199 200 '读取目标目录下的所有目录,日期目录下为各公司名称 201 Do While strSubDirs <> "" 202 On Error Resume Next 203 204 If strSubDirs <> ThisWorkbook.Name And strSubDirs <> "." And strSubDirs <> ".." Then '忽略哪些隐藏系统文件夹 205 206 If (GetAttr(strTargetDir1 & strSubDirs) And vbDirectory) = vbDirectory Then 'if foler 207 208 'Debug.Print "it is directory " & strSubDirs & " i " & i 209 ReDim Preserve strCompany(j) As String 210 strCompany(j) = strSubDirs 211 212 Debug.Print strCompany(j) 213 j = j + 1 214 215 Else 'if file 216 Debug.Print "it not a directory" 217 End If 218 End If 219 220 strSubDirs = Dir 221 222 Loop 223 224 '将公司名对于的日期存入Excel表中 225 Dim k As Integer 226 227 For k = 1 To UBound(strCompany) + 1 228 229 count = count + 1 230 231 Cells(count, 1) = strDay(i - 1) 232 Cells(count, 2) = strCompany(k - 1) 233 234 'Debug.Print "comp path is " & strTargetDir1 & strCompany(k - 1) & "\" 235 236 Dim x As Long 237 Dim iPath As String 238 iPath = strTargetDir1 & strCompany(k - 1) 239 x = 3 240 241 Call GetFolderFile(iPath, x, count) 242 243 '结束遍历单位目录下的所有文件 244 Next k 245 246 '结束遍历日目录下的所有单位目录 247 Next i 248 249 250 End Sub
附件： readfile_v1
