将特定列从多个excel文件复制到另一个excel文件的单个列

时间:2014-01-30 10:12:21

标签: vbscript

我不熟悉VBScript,我想从多个Excel工作表(Source_1.xlsx,Source_2.xlsx和Source_3.xlsx)复制特定列(比如C列)。并将其粘贴到另一个Excel工作表Dest.xlsx的A列。此列应没有重复值。任何帮助,将不胜感激。

2 个答案:

答案 0 :(得分:0)

首先,你需要创建excel对象,假设文件是​​相同的,并且你在末尾使用递增的整数,你可以迭代每个excel对象。当你迭代时,你可以调用与const相同的列,并复制到一个新的文件名。当你开始有一些代码,报告回来,它可以进一步工作

for i to x
filename = "scen_"& i & ".xlsx"
copyfilename = "copytohere.xlsx"
'set up the object

    for rowstart to rowend
    'get contents of x column
    'copy contents to copyfilename excel doc
     Loop

loop

由于

答案 1 :(得分:0)

Const xlFilterCopy = 2
Const xlUp = -4162
Const xlDown = -4121

strPathSrc = "C:\Test" ' Source files folder
strMaskSrc = "Source_*.xlsx" ' Source files filter mask
iSheetSrc = 1 ' Sourse sheet index or name
iColSrc = 3 ' Source column index, e. g. 3 for "C"
strPathDst = "C:\Test\Dest.xlsx" ' Destination file
iColDst = 1 ' Destination column index

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objSheetTmp = objWorkBookDst.Worksheets.Add
objSheetTmp.Cells(1, iColDst).Value = "TempHeader"
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(iSheetSrc)
    objSheetSrc.Cells(1, iColSrc).Insert xlDown
    objSheetSrc.Cells(1, iColSrc).Value = "TempHeader"
    Set objRangeSrc = GetRange(iColSrc, objSheetSrc)
    If objRangeSrc.Cells.Count > 1 then
        nNextRow = GetRange(iColDst, objSheetTmp).Rows.Count + 1
        objRangeSrc.AdvancedFilter xlFilterCopy, , objSheetTmp.Cells(nNextRow, iColDst), True
        objSheetTmp.Cells(nNextRow, iColDst).Delete xlUp
        Set objRangeTmp = GetRange(iColDst, objSheetTmp)
        Set objSheetDst = objWorkBookDst.Worksheets.Add
        objRangeTmp.AdvancedFilter xlFilterCopy, , objSheetDst.Cells(1, iColDst), True
        objSheetTmp.Delete
        Set objSheetTmp = objSheetDst
    End If
    objWorkBookSrc.Close
Next
objSheetTmp.Cells(1, iColDst).Delete xlUp
objExcel.DisplayAlerts = True

Function GetRange(iColumn, objSheet)
    With objSheet
        Set GetRange = .Range(.Cells(1, iColumn), .Cells(.Cells(.Cells.Rows.Count, iColumn).End(xlUp).Row, iColumn))
    End With
End Function