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

'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