bugfix> excel > 投稿

VBAにまったく新しい。しかし、ここに私が持っているコードがあります。最初のコードボックスは、Workbook1のセルXがWorkbook2のセルYと等しいことを確認することです。成功した場合、2番目のコードボックスに進み、指定されたセルからデータを取得し、アクティブな行に貼り付けます。セルは現在位置しています。 2番目のコードボックスは、アクティブなセルから開始して、アクティブな行に貼り付け関数を指定するためのオーバーホールが必要です。

現在アクティブなセルがある行を取得しようとするとエラーが発生します。

これが流れです。

  1. コマンドボタンクリック

  2. コピー元のデータを含むファイルを選択します(このワークブックには静的なセルがあるため、どのスプレッドシートが使用されているかにかかわらず、データは同じセルから取得されます)

  3. workbook1プロセス番号(静的セル)が、アクティブセルが配置されている現在の行(同じ列、行の変更)のワークブック2のプロセス番号と一致することを確認します。

    4a。成功-データをコピーして、アクティブセルから始まるアクティブな行に貼り付けます。

    4b。失敗-エラーメッセージ。コピーも貼り付けもしない

コード:

Sub Foo()
 Dim vFile As Variant
 Dim wbCopyTo As Workbook
 Dim wsCopyTo As Worksheet
 Dim wbCopyFrom As Workbook
 Dim wsCopyFrom As Worksheet
 Set wbCopyTo = ActiveWorkbook
 Set wsCopyTo = ActiveSheet
     '-------------------------------------------------------------
     'Open file with data to be copied
     vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
     "*.xl*", 1, "Select Excel File", "Open", False)
     'If Cancel then Exit
     If TypeName(vFile) = "Boolean" Then
         Exit Sub
     Else
     Set wbCopyFrom = Workbooks.Open(vFile)
     Set wsCopyFrom = wbCopyFrom.Worksheets(1)
     End If
'Process number check to see if values match and the data is being put in the correct row
Dim projectNumber As Long
Dim column As Integer  
Dim row As Integer
Dim rng As Range
'Set column and row to whatever row/column contains the Project Number in wsCopyFrom (could also use Range if its a particular cell)
projectNumber = wsCopyFrom.Range("G5).Value
Set rng = wsCopyTo.Cells.EntireRow.Select 'Get selected row in Active Worksheet
For Each c In rng.Cells    ' Check each cell in row/range
    If c.Value = projectNumber   ' Project number was found
        MsgBox("Project number found!")
        ' Insert copy and pasting code here.... See below code box
    End If
Next c
' Project number was not found in selected range if you get to this point
 MsgBox("Project Number Does Not Match")

'Close file that was opened
     wbCopyFrom.Close SaveChanges:=False

コード:

'Copy and Pasting
 wsCopyFrom.Range("F21").Copy
 wsCopyTo.Range("Active Row, beginning at Active Cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("G21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("L21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("M21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("R21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("S21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("G31").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("M31").Copy
 wsCopyTo.Range(""Active Row and Offset one column to the right from previous cell).PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("S31").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("F41").Copy
 wsCopyTo.Range(""Active Row and Offset one column to the right from previous cell).PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 wsCopyFrom.Range("G41").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

回答 1 件
  • 既存のコンテンツに貼り付けずに1つのファイルからコピーして別のファイルに貼り付ける場合は、ExcelではなくVBscriptを選択する必要があります。

    以下の例:

       strPathSrc = "C:\......" ' Source files folder
    strMaskSrc = "*.csv" ' Source files filter mask can be any format
    iSheetSrc = 3 ' Source sheet index or name sheet you want to copy
    strPathDst = "C:\....xlsx" ' Destination file
    iSheetDst = 1 ' Destination sheet index or name
    Set objExcel = CreateObject("Excel.Application")
    Set fso = CreateObject("Scripting.FileSystemObject")
    objExcel.Visible = false
    Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
    Set objSheetDst = objWorkBookDst.Sheets(iSheetDst)
    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)
        GetUsedRange(objSheetSrc).Copy
        Set objUsedRangeDst = GetUsedRange(objSheetDst)
        iRowsCount = objUsedRangeDst.Rows.Count
        objWorkBookDst.Activate
        objSheetDst.Cells(iRowsCount + 1, 1).Select
        objSheetDst.Paste
        objWorkBookDst.Application.CutCopyMode = False
        objWorkBookSrc.Close
    Next
    objExcel.ActiveWorkbook.Save
    fso.DeleteFile "C:......", True 'delete original file if required
    Function GetUsedRange(objSheet)
        With objSheet
            Set GetUsedRange = .Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, .UsedRange.Column + .UsedRange.Columns.Count - 1))
        End With
    End Function
    
    

    これをメモ帳に貼り付け、.vbsとして保存してから実行すると、並べ替えられます。必要に応じて、Windowsスケジューラでこれを自動化することもできます。

    それが役に立てば幸い

あなたの答え