0

我正在尝试从工作簿中读取一组特定的列（每周都是一个新工作簿）并将它们复制到另一个工作簿中。我已经能够做到这一点，但我认为有一种更清洁的方法来做到这一点！我的代码非常庞大且有问题，因为每周我都需要从不同的工作簿中读取信息，因此我必须返回代码并更改工作簿文件名。我会喜欢有关如何改进代码和加快更改从中复制列的工作簿的文件名的任何输入......例如，是否可以要求用户输入文件名来代替静态名称??

非常感谢任何反馈/建议！！！我的代码如下：

Sub CopyColumnToWorkbook()
Dim sourceColumns As Range, targetColumns As Range
Dim qw As Range, rw As Range
Dim sd As Range, fd As Range
Dim bu As Range, hu As Range
Dim zx As Range, gx As Range
Dim op As Range, wp As Range
Dim ty As Range, ly As Range


Set sourceColumns = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("L")
Set targetColumns = Workbooks("LU.xls").Worksheets(1).Columns("A")
Set qw = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("G")
Set rw = Workbooks("LU.xls").Worksheets(1).Columns("B")
Set sd = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("C")
Set fd = Workbooks("LU.xls").Worksheets(1).Columns("C")
Set bu = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("N")
Set hu = Workbooks("LU.xls").Worksheets(1).Columns("D")
Set zx = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("R")
Set gx = Workbooks("LU.xls").Worksheets(1).Columns("E")
Set op = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("S")
Set wp = Workbooks("LU.xls").Worksheets(1).Columns("F")
Set ty = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("I")
Set ly = Workbooks("LU.xls").Worksheets(1).Columns("G")


sourceColumns.Copy Destination:=targetColumns
qw.Copy Destination:=rw
sd.Copy Destination:=fd
bu.Copy Destination:=hu
zx.Copy Destination:=gx
op.Copy Destination:=wp
ty.Copy Destination:=ly
End Sub
4

4 回答 4

0

巧妙地接受用户输入的一种简单方法是使用该InputBox函数

Sub ReadInputBox()

    Dim readWorkbookLocation As String
    readWorkbookLocation = InputBox("What is the name of the workbook you wish to read from?", "Workbook Select")

    MsgBox workbookFile

End Sub
于 2013-02-03T12:48:32.073 回答
0

是的。您可以使用Application.GetOpenFilename让用户选择文件名。例如

Option Explicit

Sub Sample()
    Dim Ret
    Dim Wb As Workbook
    Dim ws As Worksheet

    Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")

    If Ret <> False Then
        Set Wb = Workbooks.Open(Ret)
        Set ws = Wb.Sheets("Sheet1")

        With ws
            '
            '~~> Do whatever you want to do here with the worksheet
            '
        End With
    End If
End Sub

编辑：我刚刚注意到你也标记了它excel-vba-mac。如果您在 Excel 2011 上执行此操作，请查看此链接，该链接显示如何使用Application.GetOpenFilename. 其余代码保持原样。

于 2013-02-03T14:34:57.750 回答
0

您可以使用以下简单代码循环遍历文件夹中的所有文件，而无需知道它们的名称和数量：

LoopFileNameExt = Dir(InputFolder & "*.xls?")
Do While LoopFileNameExt <> ""
'your code here
LoopFileNameExt = Dir
Loop

文件掩码中允许使用通配符。祝你好运！

于 2013-02-03T19:21:50.187 回答
0

对于这些类型的操作，我使用包含 vb 代码的单独 Excel 文件。（我将此文件称为“操作”）。在工作表上放置源/目标文件的名称。添加“选择源”、“选择目标”等按钮，它们会提示输入文件，但仅将选定的文件名放在工作表上。另一个按钮“Go”将使用指定的文件执行实际操作，例如：

在此处输入图像描述

如果要复制的列很少更改，您可以将其保留在 VBA 中。如果它不时更改或您需要多个版本，也将其放在操作工作表中。如果您需要更复杂的场景，您可以将配置放在源/目标工作簿中的另一个工作表上，以便作者可以自己指定列。

作为对您的代码的建议，对文件名使用常量/变量，以在手动更改文件名时最大限度地减少输入。还将正在操作的工作簿和工作表分配给变量。

' OPERATIONS SHEET
Dim operWB as Workbook
Dim operWS as Worksheet
Set operWB = Application.ActiveWorkbook
Set operWS = operWB.ActiveSheet

' SOURCE
Dim srcFN as string

' HARDCODED: same as before
'srcFN = "WERT_2013_01_24.xlsx"

' OR get from Cell C2
srcFN = operWS.Cell( 2, 3 )

Dim srcWB as Workbook
Dim srcWS as Worksheet
Set srcWB = Workbooks.Open( srcFN )
Set srcWS = srcWB.Worksheets( 0 )

' DESTINATION
.... do the same ...

.... OPTION 1: COPY ....
Set srcRange = srcWS.Columns( "L" ) ' <-- or get from B10
Set dstRange = dstWS.Columns( "A" ) ' <-- or get from C10
srcRange.Copy Destination:=dstRange
....

.... OPTION 2: COPY AS LOOP ....
Dim currentRow As Integer
currentRow = 10
' keep going while B10, B11... is not empty
While operWS.Cells(currentRow, 2) <> ""
    Set srcRange = srcWS.Columns( operWS.Cells(currentRow, 2) ) ' B10, B11 ...
    Set dstRange = dstWS.Columns( operWS.Cells(currentRow, 3) ) ' C10, C11 ...
    srcRange.Copy Destination:=dstRange
    currentRow = currentRow + 1
Wend
于 2013-02-03T17:07:46.097 回答