VBA實現按合并單元格拆分Excel工作表

姚曄 石翠

摘要：在Excel應用中，部門信息常見的格式設置，一種是占據一列，另一種格式為合并單元格，占據一行，文章討論的是后一種，通過合并單元格的判定，確定要包含的數據范圍，然后復制到以合并單元格提取的內容作為新建工作簿命名的文件中去。

關鍵詞：VBA；合并單元格；Excel

1 問題提出

在Excel應用中，常會遇到以合并單元格拆分數據[1]，如圖1所示。

2 解決方法

經過多次嘗試，在Excel表格中，簡單的函數功能無法實現，因此選擇采用宏（Macro）來實現。 宏是一種批處理，是一些命令組織在一起，作為一個單獨命令完成一個特定任務。Microsoft O伍ce辦公軟件自動集成“VBA”高級程序語言，使用宏語言Visual Basic將宏作為一系列指令來編寫[2]。

定義宏seprateExcel

Sub seprateExcel（）

End sub

2.1合并單元格的判定

合并單元格為班級信息，通過MergeCells來判定[3]。

Duni As Long

Dim titleCounts As Long

titleCounts=3

Dun RowCounts As Long

RowCounts= Cells（Rows.Count， l）.End（xlUp）.Row

Dim cel As Range

For i=titleCounts+1 To RowCounts

Set cel= Range（"A"&i;）

If cel.MergeCells Then

…

End If

Nexti

End Sub

2.2計算列

計算總列數的前提條件是最后一列必須保證為數據，因為列標題行所有單元格都有數據，因此，選擇標題行計算工作表的列數，再以列數得到最后一列的字母列名，這樣無論是Office哪一個版本，都可以通過計算獲得[4]。

columnTitleRow=3

Dim ColumnCounts As Long

ColumnCounts=Cells（columnTitleRow， Columns.Count）.End（xlToLeft）.Column

卜計算最后一列的列名

Dim columnLetter As String

num= ColumnCounts

Do While num>0

columnLetter=Chr《num -1）Mod 26+65）&columnLetter;

num= Int《num -1）/26）

Loop

2.3提取合并單元格內容

titleCounts=3

RowCounts= Cells（Rows.Count， l）.End（xlUp）.Row

Dim sourceFile As String

sourceFile=”成績表.xls"

Dim targetFile As String

Dim targetFilewithPath As String

Dim cel As Range

For i=titleCounts+1 To RowCounts

Set cel= Range（"A"&i;）

Ifcel.MergeCells Then

targetFile= Trim（cel）&".xls"

targetFilewithPath=ThisWorkbook.Path&”＼”&Trim;（cel）&”.xls”

Workbooks.Add

ActiveWorkbook.SaveAs targetFilewithPath

Windows（sourceFile）.Activate

…

End If

Nexti

2.4復制表頭

Windows（sourceFile）.Activate

ThisWorkbook.Sheets（"sheetl"）.Activate

Range（"Al："&columnLetter;&titleCounts;）.Copy

Windows（targetFile）.Activate

Range（"Al"）.Select

ActiveSheet.Paste

2.5復制內容

拆分工作表，首先確定拆分范圍。起止行的判定也是通過合并單元格的判定來完成。

Dim BeginRow As Long， EndRow As Long

For i=titleCounts+1 To RowCounts

Set cel= Range（"A"&i;）

Ifcel.MergeCells Then

Ifi>titleCounts+1 Then

EndRow=i-1

Windows（sourceFile）.Activate

ThisWorkbook.Sheets （" sheetl"）.Activate

Range（ "A" & BeginRow & "：" & columnLetter &EndRow;）.Copy

Windows（targetFile）.Activate

Range（"Al"）.Select

ActiveSheet.Paste

…

End If

targetFile= Trim（cel）&”.xls” targetFilewithPath=ThisWorkbook.Path&”＼”&Trim;（cel）&”.xls”

Workbooks.Add

ActiveWorkbook.SaveAs targetFilewithPath

Windows（sourceFile）.Activate

BeginRow= 1+1

End If

Nexti

EndRow= RowCounts

Windows（sourceFile）.Activate

ThisWorkbook.Sheets（" sheetl"）.Activate

Range（"A"&BeginRow;&”：”&columnLetter;&EndRow;）.Copy

Windows（targetFile）.Activate

Range（"Al"）.Select

ActiveSheet.Paste

3 結語

由于微軟辦公自動化軟件Office的普及，包含在其中的各個組件都可以利用VBA，VBA的應用有助于使工作自動化，可以使這些軟件的應用獲得更高的工作效率。另外，由于VBA可以直接應用Office套裝軟件的各項強大功能，所以，對Office進行二次程序設計和程序開發更加方便快捷。

[參考文獻]

[1]廖麗嶸基于Excel VBA的成績管理系統[J].現代計算機（專業版），2012（ 23）：64-66

[2]高世萍，翟濱，廉鎖原.基于Excel函數及Excel VBA的成績分析[J].電腦學習，2011（1）：18-19.

[3]李利民.基于Exce12007 VBA的學生成績管理系統的設計與實現[J]電腦知識與技術，2010（5）：1128-1129，1137

[4]格林.Excel 2007 VBA參考大全[M].Excel Home，譯北京：人民郵電出版社，2009