以前用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
function vbExportExcelPage(i,cols,rows,osx,cells,t,osheet,xlrow,hasInput)
??????? dim scs()
??????? redim scs(pageCount-1,cols-1)
??????? 'redim scs(pageCount*cols-1)
??????? for j=0 to pageCount-1
??????????? iRow = i*pageCount+j
??????????? if(iRow >= rows) then
??????????????? exit for
??????????? end if
??????????? set tr = t.childNodes(iRow)???????????
??????????? if(not isProgressErr) then
??????????????? 'on error resume next
??????????????? call vb_progress_show(osx,cells,rows,iRow+1)
??????????????? if err.number > 0 then
??????????????????? isProgressErr = true
??????????????? end if
??????????? end if
??????????? for h=0 to cols-1
??????????????? set td = tr.childNodes(h) 't.childNodes(iRow).cells(h)
??????????????? s = ""
??????????????? if hasInput then
??? '??????????????? if( (h=colMileage) and (iRow>0) and (iRow<rows-1) )then
??????????????????? if(td.hasChildNodes()) then
??????????????????????? if (lcase(td.firstChild.nodeName)="input") then
??????????????????????????? if (lcase(td.firstChild.type)="text") then
??????????????????????????????? s = td.firstChild.value
??????????????????? 'elseif((h=colWay) and (iRow>0) and (iRow<rows-1)) then
??????????????????????????? elseif (lcase(td.firstChild.type) = "radio") then
??????????????????????????????? if (td.firstChild.checked) then
??????????????????????????????????? s = "1"
??????????????????????????????? else
??????????????????????????????????? s = "2"
??????????????????????????????? end if
??????????????????????????? end if
??????????????????????? else
??????????????????????????? s = td.innerText
??????????????????????? end if
??????????????????? else
??????????????????????? s = td.innerText
??????????????????? end if
??????????????? else
??????????????????? s = td.innerText
??????????????? end if
??????????
??????????????? scs(j, h) = s
??????????? next
??????? next
??????? osheet.Range(osheet.Cells(xlrow, 1),osheet.Cells(xlrow+pageCount-1,cols)).value = scs
??????? erase scs
??????? call CollectGarbage()
end function
function vbmkProcessTxt(sTitle,rows)
??? s = "<html><title>" + sTitle + "导出Excel</title><body><div id='m_pub_wzs_progress_x' style='background:white;font-size:9pt;overflow:hidden;padding-top:0;position:absolute;left:10px;top:16px;'>{0}<table id='m_pub_wzs_progress_tab' border=0 cellspacing=1 bgcolor='#CCCCCC' style='border-width:1px;border-style:solid;border-left-color:#333333;border-top-color:#333333;border-right-color:#EEEEEE;border-bottom-color:#EEEEEE;'><tr height=17>"
??? dim ss(19)
??? for i=0 to 19
??????? ss(i) = "<td width=16 bgcolor='#CCCCCC'></td>"
??? next
??? s = s + join(ss,"")
??? skeydu = "<img src='../../js/kedu.jpg'>"
??? s = replace(s,"{0}",skeydu)
??? s = s + "</tr></table><span id='m_pub_wzs_progress_percent' style='font-size:10pt;vertical-align:middle;color:black;font-family:宋体'>总计" + cstr(rows) + "行,已导出<font id='sx' color='#cc0000'></font>行!<br /><font id='info' color='#008800'></font></span></div><br /><br /><br /></body></html>"
??? vbmkProcessTxt= s
end function
dim m_progressNum
m_progressNum = 0
function vb_progress_show(osx,pCells,pTotalCount,pCurrCount)
??? osx.innerText = cstr(pCurrCount)
??? m = Int(pCurrCount / pTotalCount * 20)
??? if((m<>m_progressNum) and (m>0)) then
??????? pCells(m-1).bgColor="#000088"
??? end if
??? m_progressNum = m
end function