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 在默认情况下不显示“开发工具”选项卡，因此必须使用以下过程启用该选项卡：

启用“开发工具”选项卡

  1. 在“文件”选项卡上，选择“选项”打开“Excel 选项”对话框。

  2. 单击该对话框左侧的“自定义功能区”。

  3. 在该对话框左侧的“从下列位置选择命令”下，选择“常用命令”。

  4. 在该对话框右侧的“自定义功能区”下，选择“主选项卡”，然后选中“开发工具”复选框。

  5. 单击“确定”。

    

 

在 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 变量和常量的定义

  1. VBA允许使用未定义的变量，默认是变体变量。
  2. 在模块通用说明部份，加入 Option Explicit 语句可以强迫用户进行变量定义。
  3. 变量定义语句及变量作用域

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

posted @ 2013-09-18 18:47  CrazyMann  阅读(2951)  评论(0)  编辑  收藏  举报