Excel宏編程可以快速完成批量表格操作：復(fù)制粘貼芍秆、數(shù)據(jù)過濾等契沫，宏代碼基于VB語言實(shí)現(xiàn)欺旧，有基礎(chǔ)的編程經(jīng)驗(yàn)就能快速閱讀。下面是我的學(xué)習(xí)筆記让网。
1. Excel VBA編輯界面
（進(jìn)入路徑： sheet名稱 --> 鼠標(biāo)右鍵菜單 --> 查看代碼）
2. 輸入代碼方法：
在VBE編輯器的代碼模塊中輸入VBA代碼呀忧，通常有以下幾種方法：
■ 手工鍵盤輸入；
■ 使用宏錄制器溃睹，即選擇菜單“工具——宏——錄制新宏”命令而账，將所進(jìn)行的操作自動(dòng)錄制成宏代碼；
■ 復(fù)制/粘貼代碼因篇，即將現(xiàn)有的代碼復(fù)制后泞辐，粘貼到相應(yīng)的代碼模塊中；
■ 導(dǎo)入代碼模塊：文件-->導(dǎo)入文件 **不用的模塊可以：文件-->移出模塊
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) 選擇結(jié)構(gòu)：
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) 循環(huán)結(jié)構(gòu)
Do While condition ... Loop
For i = 0 to 100 ... Next
(5) 輸出Log：
MsgBox sString
解析拷貝路徑下所有Excel到一個(gè)工作表下的示例：
Sub 合并當(dāng)前目錄下所有工作簿的全部工作表() #模塊名稱
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 #獲取當(dāng)前工作文件路徑
MyName = Dir(MyPath & "\" & "*.xls") #獲取當(dāng)前文件名（截取字符串）
AWbName = ActiveWorkbook.Name #獲取當(dāng)前BookName
Num = 0 #準(zhǔn)備進(jìn)入循環(huán)處理
Do While MyName <> "" #第一個(gè)循環(huán)體：遍歷所有文件 終止條件是 文件名為空
If MyName <> AWbName Then #條件：文件名當(dāng)前激活文件不同
Set Wb = Workbooks.Open(MyPath & "\" & MyName) # 設(shè)置工作表的名稱（當(dāng)前Sheet Name）
Num = Num + 1 #計(jì)數(shù)用于輸出
With Workbooks(1).ActiveSheet
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
#賦值語句：激活Sheet的A列最后一個(gè)單元格賦值為MyName去掉‘.xls’的部分
#Left 截取字符串 去掉了'.xls'
#workbooks(n) 為取工作簿 的寫法
#A65535(一個(gè)極大數(shù))單元格向上惜犀，最后一個(gè)非空的單元格的行號
For G = 1 To Sheets.Count #嵌套循環(huán)體：遍歷文件的所有Sheets
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
#賦值所有內(nèi)容到以結(jié)束內(nèi)容空一行開始的表格中
Next #且套循環(huán)體結(jié)束
WbN = WbN & Chr(13) & Wb.Name # & 為合并字符串的符號
Wb.Close False #對于文件操作結(jié)束铛碑，關(guān)閉Excel文件
End With #退出第二個(gè)判斷
End If #退出第一個(gè)判斷
MyName = Dir #怎么拿到第二個(gè)bookName
Loop #循環(huán)體結(jié)束
Range("B1").Select #選中B1
Application.ScreenUpdating = True #允許Excel屏幕刷新
MsgBox "共合并了" & Num & "個(gè)工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub
常用模塊：
- 把一個(gè)workBook的一塊表格拷貝到另一個(gè)WorkBook中的一般化方法：
上面的代碼中是一種簡單的實(shí)現(xiàn)：拷貝所有內(nèi)容到空行區(qū)域
需要將拷貝的內(nèi)容和粘貼的位置控制更加精準(zhǔn)控制：
拷貝指定位置到指定位置：
Workbooks("工作簿1.xls").Sheet1.Range("A1:C50").Copy ThisWorkbook.Sheet2.Range("A1")
- 找到粘貼位置：
b=sheet2.[BI].end(xlToLeft).row+1 獲取最后一次編輯的各自的列號虽界！
.Range("B65536").End(xlUp).Row + 2 最后一次編輯的格子的行號
A1 直接編輯
.Cells(nRowNo, nColNo)
...
一個(gè)將多個(gè)相同格式表格合并生成橫表的例子：
Sub 合并當(dāng)前目錄下所有工作簿的全部工作表()
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
