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

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

---

提前感谢大家的帮助

我不确定您将节省多少时间，但我建议在宏运行时禁用屏幕刷新，方法是添加

Application.ScreenUpdating = False

---

在sub的开头（很明显，结尾是同一行的

=True

）

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

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

---

这将防止在代码运行时进行计算，这会大大降低速度。将应用程序更改为原来的值很重要，因为即使在代码完成后，它仍将保持您设置它的方式，这可能会导致混乱。

我知道这很旧，但我认为对于看到这一点的其他人来说，它可能会帮助他们理解如何使自己的VBA程序性能更快。此外，下面的代码是我认为我目前可以做到的最有效的代码

关于在未来开发项目中提高性能的一些简要说明

避免连接。通常，在许多编程语言中，字符串的汇编速度很慢，因为它们主要用于与其他字符串进行比较

射程很慢。尽量少用。它们用于收集二维数组，如下面的代码中所示。只需调试以查看“data=”行上发生了什么

尝试在“只读”和“更新链接”中打开excel文件，但不要打开。在下面的代码中，我还提供了一个例子。但是，如果您开始使用.csv文件，则有一种更快的读取数据的方法，但是这种方法很快就不安全，您应该先检查数据

使用“单元格”和“范围”方法中的“调整大小”方法将范围应用于图纸。它们在应用值时更快、更高效

更改其他人已经说过的应用程序内容。我不想解释原因，因为他们已经做得很好了

希望这能帮到你：）

---

我投票结束这个问题，因为它完全适合这个问题，只要：（a）代码有效，（B）在任何方面都不是假设的或不完整的，这可能是一个好问题。如果您选择转到，请在发帖前阅读。如果您有任何问题或担忧，请加入我们的网站。我会的。抱歉弄得一团糟！A:CN、A:CY、A:CT和A:AV是每个工作表的完整范围，还是在这些范围的右侧有数据列？您的代码已完成，正在运行，并且有注释。下一份工作！

    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