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

Question

我很失败VBScript中的新特性，我想从多个Excel表格（Source_1.xlsx，Source_2.xlsx）复制特定列（比如C列） ，和Source_3.xlsx）。并将其粘贴到另一个Excel表格Dest.xlsx的列A中。该列应该没有重复值。任何帮助，将不胜感激。

Answer 1

首先，您需要创建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 

由于被加工

Answer 2

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