一小时搞定简单VBA编程 Excel宏编程快速上手

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

1. Excel VBA编辑界面

（进入路径： sheet名称 --> 鼠标右键菜单 --> 查看代码）

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
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