日期:2014-05-16  浏览次数:20378 次

vbscript、javascript快速导出Excel,并能任意设置格式,不支持合并单元格

以前用Javascript做了个导出函数,但速度很慢,后来采用粘贴的方式,速度提高了不少,
但是,刚开始时很快,到后面越来越慢,是因为占用内存的缘故,占用内存越来越多,速度就越来越慢,
找了一些回收内存的方式,但没有一个奏效的,无奈之下换成用VBScript来实现,因为VBScript有erase

换成用VBSCript后,却也没有变化,一直调试了几天,某天忽然发现导出特别快了,后面和前面一样的快,
跟踪内存,内存一直保持稳定,没有一直飑升,算法优化特别重要,比如一行:t.rows[i].cells[j] ,我把它拆开,避免每次都要从集合里取,速度也提高了一倍,效果图:进度条展示:

?

?

?



'快速导出,不支持合并单元格
isProgressErr = false
pageCount = 150?? '每页记录数(一次粘贴一页的数据)。
function vbExportExcelFast(tabId,sTitle,sHeader,arrStrs,hasInput)
??? window.event.returnValue = false
??? tBegin = Timer()
??? set t = document.getElementById(tabId).firstChild
??? rows = t.childNodes.length
??? cols = t.childNodes(0).childNodes.length
??? 'on error resume next '容错处理
??? set oXL = createObject("Excel.Application")
??? if (err.number>0) then
??????? msgbox("请确认已经安装了Excel并允许运行Excel!")
??????? exit function
??? end if
??? oXL.Workbooks.Add
??? set obook = oXL.ActiveWorkBook
??? set osheets = obook.Worksheets
??? set osheet = obook.Sheets(1)
??? xlrow = 1
???
??? '设置第二列为文本
??? if(arrStrs<>"") then
??????? sStrs = split(arrStrs,",")
??????? for i=0 to ubound(sStrs)
??????????? nStr = CInt(sStrs(i))
??????????? osheet.Range(osheet.Cells(xlrow, nStr),osheet.Cells(rows+xlrow,nStr)).Select
??????????? oXL.Selection.NumberFormatLocal = "@"
??????? next
??? end if
??? '???
??? '添加标题
??? osheet.Cells(1, 1) = sTitle
??? osheet.Range(osheet.Cells(xlrow, 1),osheet.Cells(xlrow,cols)).Select
??? oXL.Selection.HorizontalAlignment = 3
??? oXL.Selection.MergeCells = true
??? xlrow = xlrow + 1
??? '添加小标题
??? if(sHeader <> "") then
??????? osheet.Cells(2, 1) = sHeader
??????? osheet.Range(osheet.Cells(xlrow, 1),osheet.Cells(xlrow,cols)).Select
??????? oXL.Selection.MergeCells = true
??????? xlrow = xlrow + 1
??? end if
??? '进度条
??? winX = (screen.width - 300) / 2
??? winY = (screen.height - 120) / 2
??? set win = window.open("","","directories=0,location=0,memubar=0,scrollbars=0,status=0,toolbar=0,width=230,height=75,left=" + cstr(winX) + ",top=" + cstr(winY))
??? sProcess = vbmkProcessTxt(sTitle,rows)
??? win.document.write(sProcess)
??? set osx = win.document.getElementById("sx")
??? set cells = win.document.getElementById("m_pub_wzs_progress_tab").rows(0).cells

??? isProgressErr = false
??? pages = (rows - (rows mod pageCount)) / pageCount
??? if((rows mod pageCount) > 0) then
??????? pages = pages + 1
??? end if
??? 'dim scs()

??? for i = 0 to pages-1
??????? call vbExportExcelPage(i,cols,rows,osx,cells,t,osheet,xlrow,hasInput)
??????? call CollectGarbage()???????
??????? xlrow = xlrow + pageCount '不能用pageCount,因为有不满页的情况。
??? next
??? tEnd = Timer()
??? ix = cint(tEnd-tBegin)
??? if(not isProgressErr) then
??????? win.document.getElementById("info").innerText = "导出完毕,正在格式化... (" + cstr(ix) + "秒)"
??? end if

??? osheet.Range(osheet.Cells(1, 1),osheet.Cells(1,1)).Select '选择第一个单元格列
??? osheet.Columns.AutoFit
??? for i=1 to xlrow
??????? osheet.Rows(i).RowHeight = osheet.Rows(i).RowHeight + 6?? '自动大小后上下无边距,需要增加高度,要不太挤。
??? next???
??? if(not isProgressErr) then???????? '关闭进度条
??????? win.close()
??? end if
??????
??? oXL.Visible = true
??? oXL.UserControl = true
???
??? set oXL = nothing
??? set obook = nothing
??? set osheets = nothing
??? set osheet = nothing
end function