国产一级a片免费看高清,亚洲熟女中文字幕在线视频,黄三级高清在线播放,免费黄色视频在线看

Dim xlcol As Long
　　　　xlcol = 0
　　　　For j = 1 To pVS.Cols
　　　　　　If Not pVS.ColHidden(j - 1) Then
　　　　　　　　xlcol = xlcol + 1
　　　　　　　　xlSheet.cells(xlrow, xlcol).Value = pVS.TextMatrix((i - 1), (j - 1)) '加上“'”號(hào)則可以解決上面savegrid中銀行賬號(hào)的導(dǎo)出問題。
　　　　　　End If
　　　　Next j
　　　　xlrow = xlrow + 1
　　　　DoEvents
　　Next i
　　'填充表尾
　　If (sFoot <> "") Then
　　　　xlSheet.cells(xlrow, 1) = sFoot
　　　　xlSheet.Range(xlSheet.cells(xlrow, 1), xlSheet.cells(xlrow, xlColsCount)).Select
　　　　xlApp.Selection.MergeCells = True
　　　　xlrow = xlrow + 1
　　End If
　　'合并表頭
　　'--------行合并
　　Dim prevText　As String, sameStart As Long, sCell As String
　　For i = dataRow To dataRow + pVS.FixedRows - 1
　　　　prevText = ""
　　　　sameStart = 1
　　　　For j = 1 To xlColsCount

　　　　　　sCell = xlSheet.cells(i, j).Value
　　　　　　If (sCell <> prevText) Then
　　　　　　　　If (j > 1) Then
　　　　　　　　　　xlSheet.Range(xlSheet.cells(i, sameStart), xlSheet.cells(i, j - 1)).Select
　　　　　　　　　　xlApp.Selection.MergeCells = True
　　　　　　　　　　'xlSheet.cells(i, sameStart).Value = prevText
　　　　　　　　End If
　　　　　　　　sameStart = j
　　　　　　　　prevText = sCell
　　　　　　Else
　　　　　　　　xlSheet.cells(i, j).Value = ""
　　　　　　　　If (j = xlColsCount) Then
　　　　　　　　　　xlSheet.Range(xlSheet.cells(i, sameStart), xlSheet.cells(i, j)).Select
　　　　　　　　　　xlApp.Selection.MergeCells = True
　　　　　　　　End If
　　　　　　　　'sameStart = sameStart + 1
　　　　　　End If
　　　　Next j
　　Next i
　　'--------列合并
　　If pVS.FixedRows > 1 Then
　　For i = 1 To xlColsCount
　　　　prevText = ""
　　　　sameStart = dataRow
　　　　For j = dataRow To dataRow + pVS.FixedRows - 1
　　　　　　sCell = xlSheet.cells(j, i).Value
　　　　　　If (sCell <> prevText) Then
　　　　　　　　If (j > dataRow) Then
　　　　　　　　　　If prevText <> "" Then

xlSheet.Range(xlSheet.cells(sameStart, i), xlSheet.cells(j - 1, i)).Select
　　　　　　　　　　　　xlApp.Selection.MergeCells = True
　　　　　　　　　　End If
　　　　　　　　　　'xlSheet.cells(i, sameStart).Value = prevText
　　　　　　　　End If
　　　　　　　　sameStart = j
　　　　　　　　prevText = sCell
　　　　　　Else
　　　　　　　　xlSheet.cells(j, i).Value = ""
　　　　　　　　If (j = dataRow + pVS.FixedRows - 1) Then
　　　　　　　　　　If prevText <> "" Then
　　　　　　　　　　　　xlSheet.Range(xlSheet.cells(sameStart, i), xlSheet.cells(j, i)).Select
　　　　　　　　　　　　xlApp.Selection.MergeCells = True
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　'sameStart = sameStart + 1
　　　　　　End If
　　　　Next j
　　Next i
　　End If
　　
　　'設(shè)置表頭居中
　　xlSheet.Range(xlSheet.cells(dataRow, 1), xlSheet.cells(dataRow + pVS.FixedRows - 1, xlColsCount)).Select
　　xlApp.Selection.HorizontalAlignment = 3
　　　　　　　　　　
　　'自動(dòng)列寬列高
　　xlSheet.Columns.AutoFit
　　'調(diào)整行高
　　For i = 1 To vs.Rows
　　　　xlSheet.Rows(i).RowHeight = xlSheet.Rows(i).RowHeight + 6　 '自動(dòng)大小后上下無邊距，需要增加高度，要不太擠。
　　Next i

　　
　　'合并單元格
　　For i = 1 To vs.FixedRows
　　　　'for j = 1 to
　　Next i
　　
　　Me.MousePointer = vbDefault
　　xlApp.Visible = True
　　Set xlApp = Nothing
　　Set xlSheet = Nothing
End Sub
上面的代碼是通過內(nèi)容相同的方式來合并的，
VB導(dǎo)出Excel有個(gè)關(guān)鍵的問題就是速度問題，如果逐個(gè)單元格賦值，速度很慢，因?yàn)檎{(diào)用的是Excel提供的Automation，調(diào)用Automation的方法，屬于進(jìn)程之間的通信，進(jìn)程之間的方法調(diào)用，比進(jìn)程內(nèi)方法調(diào)用要慢上千倍，的確是要慢上千倍，并非夸張。
為了提高速度，應(yīng)該盡量避免進(jìn)程間方法調(diào)用的次數(shù)。

以前看過一本介紹分布式編程的書，那本書介紹了分布式編程的5個(gè)基本原則，其中有一個(gè)原則就是：
　“使用Chunky接口，而不是chatty接口”
意思就是使用粗粒度接口，而不是使用細(xì)粒度接口。

使用細(xì)粒度接口，會(huì)產(chǎn)生更多的進(jìn)程間方法屬性的調(diào)用，速度會(huì)顯著降下來。而使用粗粒度接口，減少進(jìn)程間調(diào)用次數(shù)，不把時(shí)間浪費(fèi)在連接調(diào)用進(jìn)程上，那速度會(huì)快很多。

如果要遵守這個(gè)原則來調(diào)用Excel的Automation，導(dǎo)出Excel時(shí)，盡量減少調(diào)用Excel屬性的次數(shù)，那可以通過數(shù)組賦值的方式來實(shí)現(xiàn)。通過傳遞復(fù)合數(shù)據(jù)，來代替?zhèn)鬟f單個(gè)值。
數(shù)組、集合、結(jié)構(gòu)、對象等都是復(fù)合型數(shù)據(jù)，最適合粗粒度數(shù)據(jù)傳遞，而這里導(dǎo)出Excel，唯一能用的復(fù)合型數(shù)據(jù)就是數(shù)組。

那如果要通過數(shù)組的方式寫Excel，該如何做？
其實(shí)很簡單，就是先將數(shù)據(jù)存儲(chǔ)到數(shù)組，然后再將整個(gè)數(shù)組一次性的寫入Excel里：

sh.Range(sh.Cells(a, b),sh.Cells(c,d)).value = 數(shù)組

這里帖一個(gè)通過數(shù)組賦值方式來導(dǎo)出Excel的完整例子，
這個(gè)例子，除了使用數(shù)組賦值，還用到分頁處理，分頁處理可解決內(nèi)存使用過大導(dǎo)致速度變慢的問題，但必須每處理完一頁就立即回收內(nèi)存。代碼如下：

' VBScript 文件

'快速導(dǎo)出，不支持合并單元格

'外面調(diào)用 vbExportExcelFast(tabId,sTitle,sHeader,arrStrs,hasInput) 就行了，
'它有五個(gè)參數(shù)：
'tabId 是要導(dǎo)出的表格Id, 
'sTitle　 是標(biāo)題，
'sHeader 是小標(biāo)題
'arrStrs 是需要設(shè)置數(shù)字為文本的列，對于一些很長的數(shù)字列，
'　　　 比如身份證號(hào)等，Excel會(huì)采用科學(xué)計(jì)數(shù)法表示，所以需要轉(zhuǎn)換為字符，
'　　　 有多列則用逗號(hào)分隔，注意這里的序號(hào)是從1開始的。
'hasInput 是否包含有編輯框，如果有文本框，則導(dǎo)出文本框的值 

' vbExportExcelFast("DataGrid1","應(yīng)付結(jié)算明細(xì)表",getHeader(),"1,2",false)
isProgressErr = false
pageCount = 150　 '每頁記錄數(shù)（一次粘貼一頁的數(shù)據(jù)）。
public function vbExportExcelFast(tabId,sTitle,sHeader,arrStrs,hasInput)
　　window.event.returnValue = false
　　tBegin = Timer()
　　set t = document.getElementByIdx(tabId).firstChild
　　rows = t.childNodes.length
　　cols　= t.childNodes(0).childNodes.length
　　on error resume next　'容錯(cuò)處理
　　set oXL = createObject("Excel.Application")
　　if (err.number>0) then
　　　　msgbox("請確認(rèn)已經(jīng)安裝了Excel并允許運(yùn)行Excel!")
　　　　exit function
　　end if
　　oXL.Workbooks.Add
　　set obook = oXL.ActiveWorkBook
　　set osheets = obook.Worksheets
　　set osheet = obook.Sheets(1)
　　xlrow = 1
　　
　　'設(shè)置第二列為文本
　　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
　　'　　
　　'添加標(biāo)題
　　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
　　'添加小標(biāo)題
　　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
　　'進(jìn)度條
　　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.getElementByIdx("sx")
　　set cells = win.document.getElementByIdx("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()
　　dim i
　　for i = 0 to pages-1
　　　　call vbExportExcelPage(i,cols,rows,osx,cells,t,osheet,xlrow,hasInput)
　　　　call CollectGarbage()
　　　　xlrow = xlrow + pageCount　'不能用pageCount，因?yàn)橛胁粷M頁的情況。
　　next
　　tEnd = Timer()
　　ix = cint(tEnd-tBegin)
　　if(not isProgressErr) then
　　　　win.document.getElementByIdx("info").innerText = "導(dǎo)出完畢，正在格式化... (" + cstr(ix) + "秒)"
　　end if

　　osheet.Range(osheet.Cells(1, 1),osheet.Cells(1,1)).Select　'選擇第一個(gè)單元格列
　　osheet.Columns.AutoFit
　　for i=1 to xlrow
　　　　osheet.Rows(i).RowHeight = osheet.Rows(i).RowHeight + 6　 '自動(dòng)大小后上下無邊距，需要增加高度，要不太擠。
　　next　　
　　if(not isProgressErr) then　　　　 '關(guān)閉進(jìn)度條
　　　　win.close()
　　end if
　　　 
　　oXL.Visible = true
　　oXL.UserControl = true
　　
　　set oXL = nothing
　　set obook = nothing
　　set osheets = nothing
　　set osheet = nothing
end function

public function vbExportExcelPage(i,cols,rows,osx,cells,t,osheet,xlrow,hasInput)
　　dim scs()
　　redim scs(pageCount-1,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

public function vbmkProcessTxt(sTitle,rows)
　　s = "<html><title>" + sTitle + "導(dǎo)出Excel</title><body bgColor=white><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)
　　dim i
　　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:宋體'>總計(jì)" + cstr(rows) + "行，已導(dǎo)出<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(pTotalCount<=40) then
　　　　dim i
　　　　for i=0 to m-1
　　　　　　pCells(i).bgColor="#000088"
　　　　next
　　else
　　　　if((m<>m_progressNum) and (m>0)) then
　　　　　　pCells(m-1).bgColor="#000088"
　　　　end if
　　end if
　　m_progressNum = m
end function