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