1

我想从位于文件夹中的 excel 文件中复制特定列，并将所有值粘贴到新的 excel 表中。

完全的-

  1. 我能够遍历文件夹中的所有文件。
  2. 我能够从特定列复制数据。

无法完成：

  1. 无法粘贴复制的数据。
  2. 我只想复制不同的值。
  3. 我想复制列直到行在那里。就像如果有 7 行然后复制 7 个列值。我的复制命令将所有值复制到 Excel 表的最后一行。

我的代码（VBScipt）-

strPath="C:\Test"

Set objExcel= CreateObject("Excel.Application")
objExcel.Visible= True

Set objExcel2= CreateObject("Excel.Application")
objExcel2.Visible= True

objExcel2.Workbooks.open("C:\Test\New Folder\4.xlsx")

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)

For Each objFile In objFolder.Files
If objFso.GetExtensionName(objFile.Path) = "xlsx" Then
    objExcel.Workbooks.Open(objFile.Path)

    Set Source=objExcel.Activeworkbook.Sheets(1).Columns("G")
    Source.Copy
    Set dest=objExcel2.Activeworkbook.Sheets(1).Columns("A")
    dest.Paste
    objExcel.Activeworkbook.save
    objExcel.Activeworkbook.close
    objExcel2.Activeworkbook.save
    objExcel2.Activeworkbook.close



End If

Next
4

3 回答 3

0

此函数将返回工作表上给定列的使用范围。

Private Function getRange(ByVal ColumnName As String, ByVal Sheet As Worksheet) As Range
  Set getRange = Sheet.Range(ColumnName & "1", ColumnName & Sheet.Range(ColumnName & Sheet.Columns(ColumnName).Rows.Count).End(xlUp).Row)
End Function

如果你使用它代替你的Set Source=objExcel.Activeworkbook.Sheets(1).Columns("G")它应该做你想做的事。

例如：Set Source = getRange("G", objExcel.Activeworkbook.Sheets(1))

您可能需要将您dest的单元格更改为单元格而不是列（以防 excel 抱怨它的大小错误）

Set dest = objExcel.Activeworkbook.Sheets(1).Cells("A1")

刚刚看到您将其标记为 VBScript，我尚未将其测试为 VBS，但它可能与 VBA 一样工作。

于 2013-02-16T15:12:10.613 回答
0

我认为 PasteSpecial 将有助于在 vb 脚本中粘贴。最好在 PasteSpecial 中使用 -4163 参数以确保仅粘贴值。下面的代码在 Microsoft Visual Studio 2012 中为我工作。添加注释只是为了了解程序在代码中的位置。希望这可以帮助。

Imports System.Data.OleDb
Imports System.IO
Imports System.Text

Public Class Form1
 Dim objCSV, objExcel, objSourceWorkbook, objDestWorkbook, objCSVWorkSheet, objXLSWorkSheet, srcCPUXrange, srcCPUYrange, srcMEMYrange, dstCPUXrange, dstCPUYrange, dstMEMYRange
   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

 'Create and open source CSV object
    Label1.Text = "Setting Source"
    objCSV = CreateObject("Excel.Application")
    objCSV.Visible = True
    objSourceWorkbook = objCSV.Workbooks.Open("C:\SourceFile.csv")
    Label1.Text = "Source set"

    'Create and open destination Excel object
    Label1.Text = "Setting Destination"
    objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    objDestWorkbook = objExcel.Workbooks.Open("C:\DestinationFile.xlsx")
    Label1.Text = "Destination Set"

    'Select desired range from CSV file
    Label1.Text = "Copying Data"
    objCSVWorkSheet = objSourceWorkbook.Worksheets(1)
    objCSVWorkSheet.Activate()
    objSourceWorkbook.Worksheets(1).Range("A1").EntireColumn.Copy()
    Label1.Text = "Data Copied"

    'Paste in Excel workbook 
    Label1.Text = "Pasting Data"
    objXLSWorkSheet = objDestWorkbook.Worksheets(1)
    objXLSWorkSheet.Activate()
    objDestWorkbook.Worksheets(1).Range("A2").PasteSpecial(-4163)
    Label1.Text = "Data Pasted"    


  End Sub
End Class
于 2015-03-10T18:45:14.223 回答
0

对于使用的不同复制.AdvancedFilter()方法，使用getRange()@NickSlash 定义的单元格。对于从文件中添加数据，为每个文件创建新工作表，然后将数据过滤到其中。我希望这有帮助。
VBScript

Const xlFilterCopy = 2
Const xlUp = -4162
Const xlDown = -4121
strPathSrc = "C:\Test" ' Source files folder
strMaskSrc = "*.xlsx" ' Source files filter mask
iSheetSrc = 1 ' Sourse sheet index or name
iColSrc = 7 ' Source column index, e. g. 7 for "G"
strPathDst = "C:\Test\New Folder\4.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
于 2014-02-01T00:28:59.610 回答