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

假设包含宏的工作簿有一个工作表“地图”，每个合同号都有一行：

A：合同号 B：输入工作簿的文件路径 CF：正在复制的每个列的源列字母

地图上的第 2 行在 cols 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 回答