qtp xml联合xsl输出html报表,用QTP实现数据的整理（将test1.xsl中的数据整理成result.xls）...

用QTP实现数据的整理(将test1.xsl中的数据整理成result.xls)

上一篇 /

下一篇  2013-05-16 17:01:30

/ 个人分类：QTP

'Option explicit

'Setting.WebPackage("ReplayType")=2

'删除已经存在的excel进程，避免文件打开重复

KillProcess "Excel.exe"

'创建result.xls

Set Excel=CreateObject("Excel.Application")

Set Shell=CreateObject("Wscript.Shell")

CPath = environment("TestDir")

oExcel.Workbooks.Open(CPath&"\test.xls")

wait 5

oExcel.Visible=true

oExcel.WorkSheets("Sheet1").UsedRange.Copy

set workbook=oExcel.Workbooks.Add

workbook.Worksheets("Sheet1").Range( "A1" ).PasteSpecial

workbook.Sheets("Sheet1").name="Action1"

'rename sheet1 to Action1

'RenameWorksheet oExcel, "工作簿1", "Sheet1", "Action1"

workbook.Sheets("Sheet2").Delete

workbook.Sheets("Sheet3").Delete

row=oExcel.Worksheets(1).UsedRange.Rows.count

col=oExcel.Worksheets(1).UsedRange.Columns.count

clsCount=0

Set Sheet=oExcel.Worksheets("Action1")

Set worksheet=oExcel.Worksheets

Scount=oExcel.Sheets.count

oExcel.Sheets.Add ,oExcel.Worksheets(Scount)

oExcel.Sheets(Scount+1).name="教师待定"

For clsCol=4 to col step 3

For i=2 to row

Tcher=oSheet.cells(i,clsCol)

Sclass=oSheet.cells(1,clsCol-1)

Sdate=oSheet.cells(i,1)

Scourse=oSheet.cells(i,clsCol-1)

'msgbox Tcher&"-"&Sclass&"-"&Sdata&"-"&Scourse

If  Trim(Scourse)<>"" or Trim(Tcher)<>"" Then

sheetCount =worksheet.Count

TrueCount=0

FalseCount=0

'判断是否存在教师sheet

For shCount=1 to sheetCount

'    msgbox oExcel.Worksheets(shCount).name

Select Case Tcher

Case   oExcel.Worksheets(shCount).name

TrueCount=TrueCount+1

Case ""

'                Set newSheet=oExcel.Sheets.Add

'                newSheet.name=Tcher

oExcel.Worksheets("教师待定").cells(1,1)="授课日期"

oExcel.Worksheets("教师待定").cells(1,2)="授课班级"

oExcel.Worksheets("教师待定").cells(1,3)="课程名称"

InsertValue oExcel, "教师待定",Sdate,Sclass,Scourse

Case Else

FalseCount=FalseCount+1

End Select

Next

'msgbox TrueCount&"+"&FalseCount&"="&sheetcount&"   "&Tcher&"="&oExcel.Worksheets(shCount).name

If TrueCount=1 and FalseCount=sheetCount-1 Then

InsertValue oExcel, Tcher,Sdate,Sclass,Scourse

Elseif FalseCount=sheetCount Then

oExcel.Sheets.Add ,oExcel.Sheets(Scount)

oExcel.Sheets(Scount+1).name=Tcher

oExcel.Worksheets(Tcher).cells(1,1)="授课日期"

oExcel.Worksheets(Tcher).cells(1,2)="授课班级"

oExcel.Worksheets(Tcher).cells(1,3)="课程名称"

InsertValue oExcel, Tcher,Sdate,Sclass,Scourse

End If

End If

next

next

SaveWorkbook  oExcel,"工作簿1",CPath&"\result.xls"

oExcel.Workbooks("test.xls").Close

'oExcel.Workbooks("result.xls").Close

'oExcel.Quit

Set Excel=nothing

Set Shell=nothing

引用

删除

kaqiinono /   2013-05-16 17:19:56

有待优化，欢迎大家提出宝贵意见

我来说两句

显示全部

内容

昵称

验证

提交评论