VBA - 从已关闭的工作簿中复制数据的最佳方法

时间：2016-01-20 15:18:21

标签： excel vba excel-vba

我是巴西一家工业公司的实习生，而且我正在使用excel很多。几天前我刚刚开始和VBA一起玩，我很开心它可以为我做很多事情！

我没有强大的编程背景，所以我基本上都在学习。代码工作正常，从开始到结束只需不到15秒。我不打扰时间，但如果可以改进那就太棒了。

我的主要目标是保持代码简单有效。我将在接下来的几个月内离开公司，我希望它很容易保持和使用。我所要求的是一种更好的方式来编写我的代码，以便其他人可以更容易理解，如果可能的话（当然是！）花更少的时间。

我的代码删除了当前工作簿中的4张内容，然后从其他4个已关闭的工作簿中复制更新的数据。然后关闭一切。 :)数据是关于日常生产的，他们的名字是葡萄牙语，对不起。

Sub CopiarBase()

'
' Atalho do teclado: Ctrl+q
'


    ' Variables
    Dim MyCurrentWB As Workbook
    Dim BMalharia As Worksheet
    Dim BBeneficiamento As Worksheet
    Dim BEmbalagem As Worksheet
    Dim BDikla As Worksheet

    Set MyCurrentWB = ThisWorkbook
    Set BMalharia = MyCurrentWB.Worksheets("B-Malharia")
    Set BBeneficiamento = MyCurrentWB.Worksheets("B-Beneficiamento")
    Set BEmbalagem = MyCurrentWB.Worksheets("B-Embalagem")
    Set BDikla = MyCurrentWB.Worksheets("B-Dikla")

    'Clean all the cells - Workbook 1


    Dim Malharia_rng As Range
    Set Malharia_rng = BMalharia.Range("A2:CN" & BMalharia.Cells(Rows.Count, 1).End(xlUp).Row)
    Malharia_rng.ClearContents

    Dim Ben_rng As Range
    Set Ben_rng = BBeneficiamento.Range("A2:CY" & BBeneficiamento.Cells(Rows.Count, 1).End(xlUp).Row)
    Ben_rng.ClearContents

    Dim Emb_rng As Range
    Set Emb_rng = BEmbalagem.Range("A2:CT" & BEmbalagem.Cells(Rows.Count, 1).End(xlUp).Row)
    Emb_rng.ClearContents

    Dim Dikla_rng As Range
    Set Dikla_rng = BDikla.Range("A2:AV" & BDikla.Cells(Rows.Count, 1).End(xlUp).Row)
    Dikla_rng.ClearContents


    'Copy from Malharia Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Malharia Base.xls"

    LastRowMB = Workbooks("Malharia Base.xls").Worksheets("Malharia Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Malha_base As Range
    Set Malha_base = Workbooks("Malharia Base.xls").Worksheets("Malharia Base").Range("A2:CN" & LastRowMB)

    MyCurrentWB.Worksheets("B-Malharia").Range("A2:CN" & LastRowMB).Value = Malha_base.Value
    Workbooks("Malharia Base.xls").Close

    'Copy from Beneficiamento Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Beneficiamento Base.xls"

    LastRowBB = Workbooks("Beneficiamento Base.xls").Worksheets("Beneficiamento Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Ben_base As Range
    Set Ben_base = Workbooks("Beneficiamento Base.xls").Worksheets("Beneficiamento Base").Range("A2:CY" & LastRowBB)

    MyCurrentWB.Worksheets("B-Beneficiamento").Range("A2:CY" & LastRowBB).Value = Ben_base.Value
    Workbooks("Beneficiamento Base.xls").Close

    'Copy from Embalagem Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Embalagem Base.xls"

    LastRowEB = Workbooks("Embalagem Base.xls").Worksheets("Embalagem Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Emb_base As Range
    Set Emb_base = Workbooks("Embalagem Base.xls").Worksheets("Embalagem Base").Range("A2:CT" & LastRowEB)

    MyCurrentWB.Worksheets("B-Embalagem").Range("A2:CT" & LastRowEB).Value = Emb_base.Value
    Workbooks("Embalagem Base.xls").Close

    'Copy from Dikla Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Diklatex Base.xls"

    LastRowDB = Workbooks("Diklatex Base.xls").Worksheets("Diklatex Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Dikla_base As Range
    Set Dikla_base = Workbooks("Diklatex Base.xls").Worksheets("Diklatex Base").Range("A2:AV" & LastRowDB)

    MyCurrentWB.Worksheets("B-Dikla").Range("A2:AV" & LastRowDB).Value = Dikla_base.Value
    Workbooks("Diklatex Base.xls").Close

End Sub

如果我不够清楚，我很抱歉，当然英语不是我的母语。对我的代码或整个想法的任何疑问都可以随意提问。

提前感谢任何帮助人员！

3 个答案:

答案 0 :(得分：1)

我通常会在对工作簿执行任何操作之前关闭屏幕更新，交互式并计算关闭，然后将其切换回最后的状态。

Dim oldInteractive As Boolean = Application.Interactive
Dim oldCalulation As XlCalculation = Application.Calculation
Dim oldScreenUpdating As Boolean = Application.ScreenUpdating
Application.Interactive = False
Application.Calculation = XlCalculation.xlCalculationManual
Application.ScreenUpdating = False

'Your code here

Application.Interactive = oldInteractive 
Application.Calculation = oldCalulation 
Application.ScreenUpdating = oldScreenUpdating

这将阻止在您的代码运行时进行计算，这可能会减慢很多事情。将Application.Calculation更改为旧的值非常重要，因为即使在代码完成后它仍将保持您设置的方式，这可能会导致混淆。

答案 1 :(得分：0)

我不确定你会花多少时间，但我建议在宏运行时禁用屏幕刷新，添加

Application.ScreenUpdating = False

在sub的开头（显然与末尾的​​= True相同）

答案 2 :(得分：0)

我知道这已经很老了，但我认为对于其他人来说，这可能有助于他们了解如何更快地提高自己的VBA程序性能。而且，下面的代码和我认为目前可以实现的效率一样。

一些有关在将来的开发项目中提高性能的快速说明。

  1. 避免串联。通常，在许多编程语言中，字符串（如果使用汇编语言的话）会很慢，因为它们主要用于与其他字符串进行比较。

  2. 范围很慢。尝试尽可能少地使用它们。它们用于收集二维数组，例如下面的代码。只需调试即可查看“ data =“。

  3. 尝试在“只读”和“更新链接”未打开的情况下打开excel文件。在下面的代码中，我还提供了一个示例。但是，如果您开始使用.csv文件，则有一种甚至更快的方法来读取数据，但是这种方法不安全，因此应事先检查数据。

  4. 使用单元格和范围方法中的调整大小方法将范围应用于图纸。应用值时，它们更快，更有效。

  5. 更改其他人已经说过的应用程序内容。我不会解释为什么，因为他们已经在这方面做得很好。

希望这可以帮助您：）

    Public Const file As String = "C:\Users\marco.henrique\Desktop\Bases\Malharia Base.xls"
    Public Const file_2 As String = "C:\Users\marco.henrique\Desktop\Bases\Beneficiamento Base.xls"
    Public Const file_3 As String = "C:\Users\marco.henrique\Desktop\Bases\Embalagem Base.xls"
    Public Const file_4 As String = "C:\Users\marco.henrique\Desktop\Bases\Diklatex Base.xls"
    Sub CopiarBase() ' Const is faster for the compiler
        ' Saving the Sheets Previous state.
        Dim OldIntState As Boolean: OldIntState = Application.Interactive
        Dim oldCalState As XlCalculation: oldCalState = Application.Calculation
        Dim oldSUState As Boolean: oldSUState = Application.ScreenUpdating
        Application.Interactive = False
        Application.Calculation = XlCalculation.xlCalculationManual
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False

        'Setting Sheet Values
        Dim MyCurrentWB As Workbook: Set MyCurrentWB = ThisWorkbook
        Dim BMalharia As Worksheet: Set BMalharia = MyCurrentWB.Worksheets("B-Malharia")
        Dim BBeneficiamento As Worksheet: Set BBeneficiamento = MyCurrentWB.Worksheets("B-Beneficiamento")
        Dim BEmbalagem As Worksheet: Set BEmbalagem = MyCurrentWB.Worksheets("B-Embalagem")
        Dim BDikla As Worksheet: Set BDikla = MyCurrentWB.Worksheets("B-Dikla")

        'Clean all the cells - Workbook 1, Range clearing - faster to do Sheet.usedRange.clearContents,
        ' if your clearing all sheet data
        BMalharia.UsedRange.ClearContents
        BBeneficiamento.Range(BBeneficiamento.Cells(2, 1), BBeneficiamento.Cells(BBeneficiamento.UsedRange.rows, "CY")).ClearContents
        BEmbalagem.Range(BEmbalagem.Cells(2, 1), BEmbalagem.Cells(BEmbalagem.UsedRange.rows, "CT")).ClearContents
        BDikla.Range(BDikla.Cells(2, 1), BDikla.Cells(BDikla.UsedRange.rows, "AV")).ClearContents

        'Copy from Malharia Workbook
        Dim WB As Workbook: Set WB = Workbooks.Open(file, 0, 1) ' opening the file with out updating it and in read
        ' only. if you require either of the online documentation is useful. I Just assumed you don't require these
        ' things, this does make the program run faster.
        Dim WS As Worksheet: Set WS = WB.Worksheets("Malharia Base")
        data = WS.Range(WS.Cells(2, 1), WS.Cells(WS.UsedRange.rows.count, "CN")).value
        BMalharia.Cells(2, 1).Resize(UBound(data), UBound(data, 2)).value = data
        WB.Close False

        'Copy from Beneficiamento Workbook
        Set WB = Workbooks.Open(file_2, 0, 1)
        Set WS = WB.Worksheets("Beneficiamento Base")
        data = WS.Range(WS.Cells(2, 1), WS.Cells(WS.UsedRange.rows.count, "CY")).value
        BBeneficiamento.Cells(2, 1).Resize(UBound(data), UBound(data, 2)).value = data
        WB.Close False

        'Copy from Embalagem Workbook
        Set WB = Workbooks.Open(file_3, 0, 1)
        Set WS = WB.Worksheets("Embalagem Base")
        data = WS.Range(WS.Cells(2, 1), WS.Cells(WS.UsedRange.rows.count, "CT")).value
        BEmbalagem.Cells(2, 1).Resize(UBound(data), UBound(data, 2)).value = data
        WB.Close False

        'Copy from Dikla Workbook
        Set WB = Workbooks.Open(file_4, 0, 1)
        Set WS = WB.Worksheets("Embalagem Base")
        data = WS.Range(WS.Cells(2, 1), WS.Cells(WS.UsedRange.rows.count, "AV")).value
        BDikla.Cells(2, 1).Resize(UBound(data), UBound(data, 2)).value = data
        WB.Close False

        ' Restoring the Sheets State before execution
        Application.DisplayAlerts = True
        Application.Interactive = OldIntState
        Application.Calculation = oldCalState
        Application.ScreenUpdating = oldSUState
    End Sub
相关问题
最新问题