Excel宏編程可以快速完成批量表格操作：復(fù)制粘貼、數(shù)據(jù)過濾等，宏代碼基于VB語言實(shí)現(xiàn)，有基礎(chǔ)的編程經(jīng)驗(yàn)就能快速閱讀。

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

# 舉個(gè)例子：遍歷每個(gè)Sheet把表粘貼成一個(gè)大表的語句，使用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) 循環(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è)非空的單元格的行號(hào)

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 # & 為合并字符串的符號(hào)

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

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

常用模塊：

1. 把一個(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")

2. 找到粘貼位置：

b=sheet2.[BI].end(xlToLeft).row 1 獲取最后一次編輯的各自的列號(hào)！

.Range("B65536").End(xlUp).Row 2 最后一次編輯的格子的行號(hào)

A1 直接編輯

.Cells(nRowNo, nColNo)

…

實(shí)戰(zhàn)案例分析：一個(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