excel vba宏程序编程100例 Excel宏VBA编程快速上手

Excel宏编程可以快速完成批量表格操作：复制粘贴、数据过滤等，宏代码基于VB语言实现，有基础的编程经验就能快速阅读。下面是我的学习笔记。

1. Excel VBA编辑界面

（Alt F11）

2. 输入代码方法：

在VBE编辑器的代码模块中输入VBA代码，通常有以下几种方法：

■ 手工键盘输入；

■ 使用宏录制器，即选择菜单“工具——宏——录制新宏”命令，将所进行的操作自动录制成宏代码；

■ 复制/粘贴代码，即将现有的代码复制后，粘贴到相应的代码模块中；

■ 导入代码模块：文件-->导入文件 **不用的模块可以：文件-->移出模块

3. VB代码阅读扫盲

(1) 模块声明：

Sub sName() ... End Sub Sub xxxxx() XXXXXXXXX End Sub

(2) 变量声明：

Dim sPara As sType Dim para1, para2, para3 Dim para4 As workbook, para5 As String Dim G As Long

(3) 选择结构：

With ... End With If condition Then ... End If # 举个例子：遍历每个Sheet把表粘贴成一个大表的语句，使用For Next With End With语句 With Workbooks(1).ActiveSheet 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

(4) 循环结构

Do While condition ... Loop For i = 0 to 100 ... Next

(5) 输出Log：

MsgBox sString

案例解析：解析拷贝路径下所有Excel到一个工作表下的示例：

************************************************************************************************************************************

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 #获取当前BookName Num = 0 #准备进入循环处理 Do While MyName <> "" #第一个循环体：遍历所有文件 终止条件是 文件名为空 If MyName <> AWbName Then #条件：文件名当前激活文件不同 Set Wb = Workbooks.Open(MyPath & "\" & MyName) # 设置工作表的名称（当前Sheet Name） Num = Num 1 #计数用于输出 With Workbooks(1).ActiveSheet .Cells(.Range("B65536").End(xlUp).Row 2, 1) = Left(MyName, Len(MyName) - 4) #赋值语句：激活Sheet的A列最后一个单元格赋值为MyName去掉‘.xls’的部分 #Left 截取字符串 去掉了'.xls' #workbooks(n) 为取工作簿 的写法 #A65535(一个极大数)单元格向上，最后一个非空的单元格的行号 For G = 1 To Sheets.Count #嵌套循环体：遍历文件的所有Sheets Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row 1, 1) #赋值所有内容到以结束内容空一行开始的表格中 Next #且套循环体结束 WbN = WbN & Chr(13) & Wb.Name # & 为合并字符串的符号 Wb.Close False #对于文件操作结束，关闭Excel文件 End With #退出第二个判断 End If #退出第一个判断 MyName = Dir #怎么拿到第二个bookName Loop #循环体结束 Range("B1").Select #选中B1 Application.ScreenUpdating = True #允许Excel屏幕刷新 MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示" End Sub

******************************************************************************************

常用模块：

1. 把一个workBook的一块表格拷贝到另一个WorkBook中的一般化方法：

上面的代码中是一种简单的实现：拷贝所有内容到空行区域

需要将拷贝的内容和粘贴的位置控制更加精准控制：

拷贝指定位置到指定位置：

Workbooks("工作簿1.xls").Sheet1.Range("A1:C50").Copy ThisWorkbook.Sheet2.Range("A1")

2. 找到粘贴位置：

b=sheet2.[BI].end(xlToLeft).row 1 获取最后一次编辑的各自的列号！ .Range("B65536").End(xlUp).Row 2 最后一次编辑的格子的行号 A1 直接编辑 .Cells(nRowNo, nColNo)

实战案例分析：一个将多个相同格式表格合并生成横表的例子：

Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Dim HasTitil As Boolean Dim LastRange As String Dim CurRowNo As Long Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = ActiveWorkbook.Name Num = 0 HasTitil = False With Workbooks(1).ActiveSheet .Cells(1, 2) = "Cor.Name" Do While MyName <> "" If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num 1 .Cells(1, Num 2) = Left(MyName, Len(MyName) - 4) If HasTitil <> True Then Wb.Sheets(1).Range("A4:B43").Copy .Cells(2, 1) Wb.Sheets(1).Range("E4:F43").Copy .Cells(.Range("A65536").End(xlUp).Row 1, 1) Wb.Sheets(2).Range("A5:B73").Copy .Cells(.Range("A65536").End(xlUp).Row 1, 1) Wb.Sheets(2).Range("E5:F73").Copy .Cells(.Range("A65536").End(xlUp).Row 1, 1) Wb.Sheets(3).Range("A4:B32").Copy .Cells(.Range("A65536").End(xlUp).Row 1, 1) Wb.Sheets(3).Range("E4:F32").Copy .Cells(.Range("A65536").End(xlUp).Row 1, 1) Wb.Sheets(4).Range("A5:B100").Copy .Cells(.Range("A65536").End(xlUp).Row 1, 1) HasTitil = True End If CurRowNo = 2 Wb.Sheets(1).Range("D4:D43").Copy .Cells(CurRowNo, Num 2) CurRowNo = CurRowNo 40 Wb.Sheets(1).Range("H4:H43").Copy .Cells(CurRowNo, Num 2) CurRowNo = CurRowNo 40 Wb.Sheets(2).Range("D5:D73").Copy .Cells(CurRowNo, Num 2) CurRowNo = CurRowNo 69 Wb.Sheets(2).Range("H5:H73").Copy .Cells(CurRowNo, Num 2) CurRowNo = CurRowNo 69 Wb.Sheets(3).Range("D4:D32").Copy .Cells(CurRowNo, Num 2) CurRowNo = CurRowNo 29 Wb.Sheets(3).Range("H4:H32").Copy .Cells(CurRowNo, Num 2) CurRowNo = CurRowNo 29 Wb.Sheets(4).Range("D5:D100").Copy .Cells(CurRowNo, Num 2) Wb.Close False End If MyName = Dir Loop End With Range("B1").Select Application.ScreenUpdating = True End Sub