【问题标题】:update links prompt issue更新链接提示问题
【发布时间】:2017-01-27 20:22:46
【问题描述】:

我有一个长度代码,它可以打开一组文件、取消隐藏并导航到特定工作表、复制一个范围并将该范围粘贴到另一个工作簿中。

问题是每当代码打开这些文件时,都会出现一条更新链接的弹出消息。我知道它可以通过 updatelinks = 0 来解决,但是我想知道我应该在我的代码中的哪个位置包含它。

代码也需要时间来执行,所以是否有任何修改可以加快执行速度。

Sub mergeallinputworkbooks()  
    Dim wkbDest As Workbook
    Dim wksDest As Worksheet
    Dim wkbSource As Workbook
    Dim wksSource As Worksheet
    Dim MyPath As String
    Dim MyFile As String
    Dim FolderName As String
    Dim oCell As Range          
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False 
    Set wkbDest = ThisWorkbook
    Set wksDest = wkbDest.Worksheets("Master Data") 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        On Error Resume Next
        FolderName = .SelectedItems(1)
        Err.Clear
        On Error GoTo 0
    End With 
    MyPath = FolderName 
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" 
    MyFile = Dir(MyPath & "*.xls")
    Do While Len(MyFile) > 0
        Set wkbSource = Workbooks.Open(MyPath & MyFile)
        Set wksSource = wkbSource.Worksheets("Scoring DB")
        ActiveWorkbook.Unprotect ("pyroo123")
        Sheets("Scoring DB").Visible = True
        Sheets("Scoring DB").Select
        Range("A4:W4").Copy
        Windows("Performance Dashboard.xlsm").Activate
        With Sheets("Master Data").Range("$A:$A")
        With Sheets("Master Data")
Set oCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
oCell.Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Windows("Performance Dashboard.xlsm").Activate
    End With  
        wkbSource.Close savechanges:=False
        MyFile = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True  
End Sub

【问题讨论】:

    标签: vba excel


    【解决方案1】:

    对于您的链接问题,have a look at this post。那里应该有足够的信息,可以让您很好地了解如何以及在何处使用链接更新。

    现在的代码建议
    为了提高代码的性能,我建议不要在不必要的地方与工作表交互。而不是“复制和过去”将范围分配给数组:

    arrMyRange = Worksheets("SourceWorksheet").Range("A4:W4")
    

    这将创建您的数组。现在将数组分配给您的位置:

    Worksheets("DestinationWorksheet").Range("A1").Resize(UBound(arrMyRange, 1), UBound(arrMyRange, 2)).Value = arrMyRange 
    

    A1 可以根据需要动态更改。

    【讨论】:

    • 请告诉它应该包含在哪里。可以的话可以修改一下代码
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2021-02-02
    • 1970-01-01
    • 2011-01-30
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多