Question

尝试编写一个宏，可以帮助将数千个旧文件中的信息传输到新格式化的文件。大多数是标准的，所以我有一个宏，可以将“旧”书籍上指定范围的值转移到“新”书籍上的指定范围，相对无痛（感谢本网站）。

但是，某些旧文件是非典型格式的，并且范围与我的宏中指定的范围不匹配。因此，我认为在这些情况下让用户定义要复制的范围是有意义的。

我尝试将值指定为=，并且我尝试过复制粘贴，但到目前为止都没有。任何线索都将非常感激。

这是迄今为止的代码（这只是一次迭代，就像我说我一直在尝试一堆不同的东西）：

sub magic_select()

    Dim wb As Workbook, wb2 As Workbook
    Dim vfile As Variant
    Dim name As String
    Dim oldname As String
    Dim Cvalves, Ovalves, breakers, safety_inst, procedure_ID, Pvalves, Pbreakers, electest As String

    'set source workbook
    Set wb = ActiveWorkbook

    'open target workbook
    vfile = Application.GetOpenFilename("Excel-Files,*.xls*", _
        1, "Select One File to Open", , False)

    'if nothing selected, exit sub
    If TypeName(vfile) = "Boolean" Then Exit Sub

    'open selected file
    Workbooks.Open vfile

    'set target workbook
    Set wb2 = ActiveWorkbook

      'procedure_ID = Application.InputBox(Prompt:="select procedure ID: one cell", Type:=8)
       Cvalves = Application.InputBox(Prompt:="select valves to be locked closed", Type:=8)
       Ovalves = Application.InputBox(Prompt:="select valves to be locked open", Type:=8)
       breakers = Application.InputBox(Prompt:="select breakers to be opened and locked out", Type:=8)
       safety_inst = Application.InputBox(Prompt:="select Special Safety Instructions", Type:=8)
       Pvalves = Application.InputBox(Prompt:="select valves from Procedure(page 2)", Type:=8)
      Pbreakers = Application.InputBox(Prompt:="select breakers from Procedure (page2)", Type:=8)
       electest = Application.InputBox(Prompt:="select Electrical Test Procedure", Type:=8)

    'copies all the appropriate values to blank form
    'wb is blank form (copy to)
    'wb2 is old LOTO form (copied from)
    'edit values as needed
    wb.Worksheets(1).Range("e11, e85").Value = 
    wb2.Worksheets(1).Range("e11").Value
    wb.Worksheets(1).Range("E21:I45").Value = Range("Cvalves").Value
    wb.Worksheets(1).Range("E50:I61").Value = Range("Ovalves").Value
    wb.Worksheets(1).Range("E95:G121").Value = Range("breakers").Value
    wb.Worksheets(1).Range("a124:a128").Value = Range("breakers").Val
    wb.Worksheets(1).Range("h70, c132").Value = Range("procedure_ID").Value
    wb.Worksheets(2).Range("a10:f54").Value = Range("Pvalves").Value
    wb.Worksheets(2).Range("a60:f89").Value = Range("Pbreakers").Value
    wb.Worksheets(2).Range("a92:a97").Value = Range("Electest").Value

    name = wb2.name
    oldname = "_done_" & name


    'resaves old file under new name
    wb2.SaveAs Filename:="xyz" & oldname, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    'closes old file
    wb2.Close

    'deletes old duplicate file
    Kill vfile

    'Set wb = ActiveWorkbook

    'saves as new, separate LOTO form
     wb.SaveAs Filename:="zyx" & name, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    're-open blank macro form
    Workbooks.Open ("C:\Users\me.etc")

    'closes new file
    wb.Close

End Sub

Answer 1

1- Application.InputBox(..., Type:=8)的返回值为Range object。首先，适当地调暗你的变量。

Dim Cvalves As Range, Ovalves As Range, breakers As Range, ' etc..

2- Set到用户所选范围的范围：

  Set Cvalves = Application.InputBox(Prompt:="select valves to be locked closed", Type:=8)
' ^^^

3-现在，您可以将用户选择的范围复制到适当的目的地，即

CValves.Copy wb.Worksheets(1).Range("E21")

或者您可以（最好）通过直接分配值来进行复制：

wb.Worksheets(1).Range("E21").Resize(CValves.Rows.Count, CValves.Columns.Count).Value = CValves.Value2

您需要按照此方法使用用户将选择的所有范围。我觉得这种方法容易出错，因为用户必须选择这么多范围并且可能会出错。但如果这是唯一的选择，那就是如何实现它。

从输入框提示符（wb1）获取范围，将值传输到定义的范围（wb2）

1 个答案: