1

フォルダーにある Excel ファイルから特定の列をコピーし、すべての値を新しい Excel シートに貼り付けたいと考えています。

完成～

  1. フォルダーにあるすべてのファイルをループできます。
  2. 特定の列からデータをコピーできます。

完了できません:

  1. コピーしたデータを貼り付けることができません。
  2. 個別の値のみをコピーしたい。
  3. 行が存在するまで列をコピーしたい。7行ある場合のように、列の7つの値をコピーします。私のコピーコマンドは、すべての値をExcelシートの最後の行までコピーしています。

私のコード (VBSipt)-

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

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()from @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 に答える
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 に答える