Excel宏编程可以快速完成批量表格操作：复制粘贴、数据过滤等，宏代码基于VB语言实现，有基础的编程经验就能快速阅读。下面是我的学习笔记。
1. Excel VBA编辑界面
（Alt+F11）
2. 输入代码方法：
在VBE编辑器的代码模块中输入VBA代码，通常有以下几种方法：
■ 手工键盘输入；
■ 使用宏录制器，即选择菜单“工具——宏——录制新宏”命令，将所进行的操作自动录制成宏代码；
■ 复制/粘贴代码，即将现有的代码复制后，粘贴到相应的代码模块中；
■ 导入代码模块：文件-->导入文件 **不用的模块可以：文件-->移出模块
3. VB代码阅读扫盲
(1) 模块声明：
Sub sName() ... End SubSub xxxxx()XXXXXXXXXEnd Sub(2) 变量声明：
Dim sPara As sTypeDim para1, para2, para3Dim para4 As workbook, para5 As StringDim G As Long(3) 选择结构：
With ... End WithIf condition Then ... End If# 举个例子：遍历每个Sheet把表粘贴成一个大表的语句，使用For Next With End With语句With Workbooks(1).ActiveSheetFor G = 1 To Sheets.CountWb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)NextWbN = WbN & Chr(13) & Wb.NameWb.Close FalseEnd With(4) 循环结构
Do While condition ... LoopFor i = 0 to 100 ... Next(5) 输出Log：
MsgBox sString案例解析：解析拷贝路径下所有Excel到一个工作表下的示例：
Sub 合并当前目录下所有工作簿的全部工作表() #模块名称Dim MyPath, MyName, AWbName #变量声明Dim Wb As workbook, WbN As StringDim G As LongDim Num As LongDim BOX As StringApplication.ScreenUpdating = False #停止屏幕刷新MyPath = ActiveWorkbook.Path #获取当前工作文件路径MyName = Dir(MyPath & "\" & "*.xls") #获取当前文件名（截取字符串）AWbName = ActiveWorkbook.Name #获取当前BookNameNum = 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 #嵌套循环体：遍历文件的所有SheetsWb.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 #怎么拿到第二个bookNameLoop #循环体结束Range("B1").Select #选中B1Application.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, AWbNameDim Wb As Workbook, WbN As StringDim G As LongDim Num As LongDim BOX As StringDim HasTitil As BooleanDim LastRange As StringDim CurRowNo As LongApplication.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & "\" & "*.xls")AWbName = ActiveWorkbook.NameNum = 0HasTitil = FalseWith Workbooks(1).ActiveSheet.Cells(1, 2) = "Cor.Name"Do While MyName <> ""If MyName <> AWbName ThenSet Wb = Workbooks.Open(MyPath & "\" & MyName)Num = Num + 1.Cells(1, Num + 2) = Left(MyName, Len(MyName) - 4)If HasTitil <> True ThenWb.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 = TrueEnd IfCurRowNo = 2Wb.Sheets(1).Range("D4:D43").Copy .Cells(CurRowNo, Num + 2)CurRowNo = CurRowNo + 40Wb.Sheets(1).Range("H4:H43").Copy .Cells(CurRowNo, Num + 2)CurRowNo = CurRowNo + 40Wb.Sheets(2).Range("D5:D73").Copy .Cells(CurRowNo, Num + 2)CurRowNo = CurRowNo + 69Wb.Sheets(2).Range("H5:H73").Copy .Cells(CurRowNo, Num + 2)CurRowNo = CurRowNo + 69Wb.Sheets(3).Range("D4:D32").Copy .Cells(CurRowNo, Num + 2)CurRowNo = CurRowNo + 29Wb.Sheets(3).Range("H4:H32").Copy .Cells(CurRowNo, Num + 2)CurRowNo = CurRowNo + 29Wb.Sheets(4).Range("D5:D100").Copy .Cells(CurRowNo, Num + 2)Wb.Close FalseEnd IfMyName = DirLoopEnd WithRange("B1").SelectApplication.ScreenUpdating = TrueEnd Sub
