0

私はこれをあまりにも長い間手動で行ってきましたが、このプロセスをスピードアップする方法が必要だと感じています. うまくいけば、あなたたちは私を助けることができます.

現在、あるシートから特定の列をコピーして貼り付け、別のシートに貼り付ける VBA マクロで記述された Excel ファイルがあります。これらは約 160 個あり、それぞれに約 10 個のコピー/貼り付けコマンドがあります。(このワークブックは と呼ばれworkbook Aます)

現在、私の方法では、 を開きWorkbook B、 のシートにデータをコピーしWorkbook A、 のドロップダウンから実行するマクロを選択しWorkbook A、結果をコピーして「マスター」に貼り付けますWorkbook C。私にとっての問題は、データの列の位置であるマップが変更されることが頻繁にあることですWorkbook B。次のような「マスターマップ」ファイルを維持しています。

Contract# | Purchaser | Price | Quantity | Total
------------------------------------------------
A         |  B        |  C    |  D       |  E
------------------------------------------------
G         |  D        |  C    |  A       |  B
------------------------------------------------

など（乱雑で申し訳ありません）

私がやりたいことは、A: マップ上の列 (貼り付け列) と B: その特定の契約の行に表示されている文字 (これはその列をコピーします文字が表す）。

これは可能ですか？

第二に、それが - 各ファイルのファイルパッチを指定することによってこれを自動的に実行させるオプションは傑出しています (私はファイルの場所と名前の明確な分類法を持っています)。それも可能ですか？

  • 実行されたマクロの要約サンプルが追加されました。

マクロは非常に単純です。ここにサンプルがあります...

 Sub PA979()
 Application.ScreenUpdating = False

   'Retail $
    Sheets("VSR Input").Select
   Range("x1:x5004").Copy
   Sheets("Sheet1").Select
   Range("q4").Select
   ActiveSheet.Paste

   'PA $
    Sheets("VSR Input").Select
   Range("y1:y5004").Copy
   Sheets("Sheet1").Select
   Range("s4").Select
   ActiveSheet.Paste

'Q
    Sheets("VSR Input").Select
   Range("z1:z5004").Copy
   Sheets("Sheet1").Select
   Range("t4").Select
   ActiveSheet.Paste

   'Total $
    Sheets("VSR Input").Select
   Range("aa1:aa5004").Copy
   Sheets("Sheet1").Select
   Range("u4").Select
   ActiveSheet.Paste
   Range("A1").Select

    Dim ws As Worksheet
Set ws = Worksheets("Sheet1")

Dim usedRows As Long
usedRows = ws.Cells(ws.Rows.Count, "U").End(xlUp).Row
Application.ScreenUpdating = False

    Sheets("Sheet1").Select
Range("v3").Select
   ActiveCell.FormulaR1C1 = "PA#"
   ActiveCell.Offset(1, 0).Range("A1").Select
   ActiveCell = "979"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range(Cells(1, 1), Cells(usedRows - 3, 1)), Type:= _
        xlFillDefault
        Range("v4").Select
        Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste

    ActiveSheet.Range("A1").Select

End Sub `
4

1 に答える 1

1

マクロを含むワークブックに、契約番号ごとに 1 行のワークシート "マップ" があると仮定します。

A: 契約番号 B: 入力ワークブックのファイル パス CF: コピーされる各列のソース列文字

マップ シートの行 2 には、列 CF に目的地の列の文字があります。

コンパイル済みだがテストされていない:

Option Explicit


Sub Tester()
    CopyData 979
End Sub



Sub CopyData(contractNumber)

Dim wbInput As Workbook
Dim wbDest As Workbook
Dim shtIn As Worksheet, shtDest As Worksheet, shtMap As Worksheet
Dim usedRows As Long
Dim arrDestCols, x As Integer, cFrom, cTo
Dim f As Range, mapRow As Range

    'has the column mapping info for each contract number
    Set shtMap = ThisWorkbook.Sheets("Map")
    'find the row for this contract number
    Set f = shtMap.Range("A3:A100").Find(contractNumber, , xlValues, xlWhole)
    If f Is Nothing Then
        MsgBox "contract number " & contractNumber & " not found!"
        Exit Sub
    Else
        Set mapRow = f.EntireRow
    End If

    'assumes input file path is in column B
    Set wbInput = Workbooks.Open(mapRow.Cells(2).Value)
    Set shtIn = wbInput.Sheets("VSR Input")

    Set wbDest = ThisWorkbook
    Set shtDest = wbDest.Sheets("Sheet1")

    Application.ScreenUpdating = False

    For x = 1 To 4
        ' "source" column letters are in columns C-F of the found row
        cFrom = mapRow.Cells(2 + x).Value
        ' "destination" column letters are in C2:F2 of the Map sheet
        cTo = shtMap.Rows(2).Cells(2 + x).Value
        shtIn.Range(cFrom & "1").Resize(5004, 1).Copy shtDest.Range(cTo & "4")
    Next x

    With shtDest
        usedRows = .Cells(.Rows.Count, "U").End(xlUp).Row
        .Range("v3").Value = contractNumber
        .Range("v4").Resize(usedRows - 3, 1).Value = contractNumber
    End With

    wbInput.Close False

End Sub
于 2013-03-19T18:05:56.643 に答える