使用多个Excel文件

时间:2015-10-21 18:25:30

标签: excel qtp

我有10个Excel文件,名称为A1,A2,A3,A4,A5,A6,A7,A8,A9和A10(均为.xlsx格式)。我的要求是单独读取每个Excel,添加一些公式并根据某些条件过滤数据并将第五列数据(不包括标题(第一行))复制到另一个Excel。

我做了类似的事情,但它只适用于一张Excel表格。我不知道如何为多个Excel文件更改它。

'开始

DataTable.AddSheet "Sheet1"
DataTable.ImportSheet "A:\Trail 1\Data.xlsx","Sheet1","Sheet1"
RowCount= DataTable.GetSheet("Sheet1").GetRowCount

Set objexcel = CreateObject("excel.application") 
Set objWorkbook = objExcel.WorkBooks.Open ("A:\Trail 1\Data.xlsx")
Set objSheet = objWorkbook.Worksheets(1)

objexcel.Visible=false

objexcel.Rows(1).Insert
objexcel.Columns(2).Insert
objexcel.Columns(2).Insert

objSheet.cells(1,1).value="Minutes Interval"
objSheet.cells(1,2).value="Hour Interval"
objSheet.cells(1,3).value="Hourly Filter"
objSheet.cells(1,4).value="HH:MM:SS"
objSheet.cells(1,5).value="Weight(g)"

For i = 2 To RowCount+2 Step 1

objSheet.cells(i,2).value="=A"&i&"/60"
objSheet.cells(i,3).value="=INT(B"&i&")=B"&i

Next

ObjSheet.cells(2,3).autofilter 3,"True"
Set objRange = objSheet.Range("A1")  
objWorkbook.Worksheets(1).UsedRange.Copy '--- to copy entire sheet data to    an intermediate excel

Set objWorkbookn= objExcel.Workbooks.Open ("A:\Trail 1\In   termediateExcel.xlsx")
Set objSheetn = objWorkbookn.Worksheets(1)
objWorkbookn.Worksheets(1).Range("A1").PasteSpecial Paste =xlValues '-- pasted here on intermediate excel
Set objWorkbook2= objExcel.Workbooks.Open ("A:\Trail 1\Result.xlsx") '--- open result excel file   

objSheetn.Activate  '-activate the intermediate sheet and get row count
rc=objWorkbookn.Worksheets("Sheet1").UsedRange.rows.count
Set src = objWorkbookn.Worksheets(1)
Set dest = objWorkbook2.Worksheets(1)
Const sourceColStart = 5
Const destColStart = 5
Const destRowStart = 2 'current row
Const destRowStart = 2 'current row
Dim currentRow 
currentRow = destRowStart


For i = 0 To rowcount
    dest.Cells(currentRow,destColStart).Value = src.Cells(currentRow, sourceColStart)
    currentRow = currentRow + 1
Next

objWorkbook.save
objWorkbook.close
objWorkbook2.save
objWorkbook2.close
objWorkbookn.save
objWorkbookn.close

'完

1 个答案:

答案 0 :(得分:0)

我使用了类似下面的内容来循环浏览文件。还可以循环遍历目录。已经在SO上有一些你可以搜索的帖子。

Dim filesToOpen

filesToOpen = Application.GetOpenFilename( _
    FileFilter:="Excel 97-2003 Files (*.xls*), *.xls*", _
    Title:="Excel files to Open", _
    MultiSelect:=True)

For i = LBound(FilesToOpen) To UBound(FilesToOpen)

objWorkbookn = Workbooks.Open(filesToOpen(i))

'do stuff

Next i