根据分类字段将电子表格拆分成多个文件

利用本脚本可以将Excel中数据，根据分类字段生成不同的文件。
需要的文件：源数据及配置文件（data.xls），模板文件(style.xlt)，脚本文件(xx.vbs)。
配置信息：
分类列号：用于生成不同分类文件的列号
源文件的标题行号：用于复制到分类文件的标题所在的行号。
源文件的正文行号：用于复制到分类文件的正文的起始行号。
目标文件的标题行号：在生成分类文件中的标题所在的行号。
目标文件的正文行号：在生成分类文件中的正文的起始行号。
内容列号：需要复制到分类文件的列号列表。格式如下，列号1+逗号+列号2。如：1,2,3
文件名前缀：生成分类文件时，文件名的附加内容。
分类文件格式的控制：在源文件夹内的style.xlt进行分类文件格式的设计。生成的分类文件基于设计的模板文件。
生成分类文件目录：生成的分类文件在源文件夹下的output目录。
脚本文件功能：根据配置文件，将数据文件据分类列及标题、正文的行号设置，按模板格式拆分成多个单文件。
脚本代码如下：

Set objExcelApp = CreateObject("Excel.Application")
Set objExcelTarge = CreateObject("Excel.Application")


dim sheetname
dim str_area
dim curr_row,target_row
dim col_data,count_col
dim count_num

dim index_col,str_title
dim target_title_row,target_start_row
dim title_row,start_row
dim str_col

objExcelApp.Workbooks.Open "d:\\excel\\data.xls"
sheetname =  "Sheet1"
objExcelApp.Worksheets(sheetname).Activate
'objExcelApp.Visible = true

str_cell_data=objExcelApp.Worksheets(sheetname).cells(1,2).value
index_col=cint(str_cell_data)

str_cell_data=objExcelApp.Worksheets(sheetname).cells(1,4).value
title_row=cint(str_cell_data)

str_cell_data=objExcelApp.Worksheets(sheetname).cells(1,6).value
start_row=cint(str_cell_data)

str_cell_data=objExcelApp.Worksheets(sheetname).cells(1,8).value
target_title_row=cint(str_cell_data)

str_cell_data=objExcelApp.Worksheets(sheetname).cells(1,10).value
target_start_row=cint(str_cell_data)

str_cell_data=objExcelApp.Worksheets(sheetname).cells(1,12).value
str_col=str_cell_data  '使用列

str_cell_data=objExcelApp.Worksheets(sheetname).cells(1,14).value
str_title=str_cell_data



'index_col=1  '索引列
'start_row=3 '源文件正文起始列
'target_start_row=5  '目标文件正文起始列
'str_col="1,3,2"  '使用列
'str_title="文件演示"


curr_row=start_row
target_col=0
col_data=split(str_col,",")
count_col=ubound(col_data)

count_num=0

str_area=""

while (objExcelApp.Worksheets(sheetname).cells(curr_row,index_col).value<>"")

    if(str_area<>objExcelApp.Worksheets(sheetname).cells(curr_row,index_col).value  ) then
'存盘
        if(count_num>0) then

            objExcelTarge.ActiveWorkBook.SaveAs "d:\excel\output\"   & str_area & "_" & str_title & ".xlsx"
            objExcelTarge.ActiveWorkBook.Saved = True 
            objExcelTarge.Workbooks.Close
        end if

    objExcelTarge.Workbooks.add  "d:\\excel\\style.xlt"
    objExcelTarge.Worksheets(sheetname).Activate
    objExcelTarge.Visible = true

    count_num=count_num+1

    target_row=target_start_row

    '加标题
    for curr_col=0 to count_col
        y=cint(col_data(cint(curr_col)))
        str_source=objExcelApp.Worksheets(sheetname).cells(title_row,y).value
        objExcelTarge.Worksheets(sheetname).cells(target_title_row,cint(curr_col+1)).value=str_source
    next

    end if 

    '加记录

    for curr_col=0 to count_col
        y=cint(col_data(cint(curr_col)))
        str_source=objExcelApp.Worksheets(sheetname).cells(curr_row,y).value
        objExcelTarge.Worksheets(sheetname).cells(target_row,cint(curr_col+1)).value=str_source
    next
    target_row=target_row+1
    str_area=objExcelApp.Worksheets(sheetname).cells(curr_row,index_col).value
    curr_row=curr_row+1
wend
if(count_num>0) then
    objExcelTarge.ActiveWorkBook.SaveAs "d:\excel\output\"   & str_area & "_" & str_title & ".xlsx"
    objExcelTarge.ActiveWorkBook.Saved = True 
    objExcelTarge.Workbooks.Close
end if
objExcelApp.ActiveWorkBook.Saved = true
objExcelApp.Workbooks.Close
objExcelApp.quit
objExcelTarge.quit
msgbox "处理结束"

效果图