Question

在此先感谢您的帮助。我的知识是初级水平。我可以阅读代码，但在编写上却很费力。

此外，我认为总会有一种更好（更有效）的代码编写方式。

解决方案是多个目标的结合：
1.具有分配的宏的命令按钮（完成）
2.错误处理（为此有一些代码）
3.确定要从中转移的第二个工作簿（对此有代码）
4.将90多个命名范围的值复制并粘贴到工作簿A中（使用宏记录器的caveman代码）
5.将5个名称范围的对象（图片）复制并粘贴到工作簿A（到目前为止尚未实现）
6.用户反馈（传输成功或传输失败，并显示错误消息）

代码：（跳过目标1）

Sub Button_Transfer_FromOlderVersion()

' Start of Error Handling
    On Error GoTo Errorcatch

' Declare string variable and use current open workbook filename as value
    Dim WorkbookNameNew As String
    WorkbookNameNew = ThisWorkbook.Name

' Declare string variable for 2nd workbook not yet identified
    Dim WorkbookNameOld As String

' Find out the name of the 2nd workbook
' Declare string variable for finding and separating the filename from the path
    Dim sFileName As String

' Show the open dialog and pass the selected file name to the string variable "sFileName"
    sFileName = Application.GetOpenFilename

' If the user cancels finding the workbook file then exit subroutine
    If sFileName = "False" Then Exit Sub

' Troubleshooting: Show me the filename with path of Workbook B  
    MsgBox sFileName

' Troubleshooting: Show me the filename of Workbook A  
    MsgBox WorkbookNameNew

' Open Workbook B which the user just selected
    Workbooks.Open Filename:=sFileName

' Separate the filename from the path for Workbook B
    WorkbookNameOld = Dir(sFileName)

' Troubleshooting: Show me the filename of Workbook B 
    MsgBox WorkbookNameOld

' Make sure Workbook B is the active workbook
    Windows(WorkbookNameOld).Activate

' Make sure the correct worksheet is active
    Worksheets("WorksheetName").Activate

' Select and copy the value of the first Named Range
    Range("NamedRange01").Select
    Selection.Copy

' Make Workbook A the active workbook
    Windows(WorkbookNameNew).Activate

' Select the corresponding Named Range in Workbook A
    Range("NamedRange01").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

' User Feedback of successful transfer and name of Workbook B
    MsgBox ("TRANSFER COMPLETED FROM:" & " " & WorkbookNameOld)


Exit Sub


' Finish Error Handling
Errorcatch:
MsgBox Err.Description

End Sub

我很抱歉，如果间距，缩进和注释未针对阅读进行优化。我仍在学习最佳做法。

请注意：某些名称范围的拼写不同，我需要对其进行映射，以便复制/粘贴准确。

此外，与其使用复制/粘贴，不如在数组中列出所有具有相关变量的命名范围不是更好吗？并且将所有值和对象复制到Array然后切换到Workbook A并粘贴所有内容，不是更好吗？

再次感谢您的帮助。

Answer 1

在复制或粘贴之前，您无需费心激活工作簿或工作表。那只会减慢速度。此外，您还可以进行屏幕更新和计算，以加快处理速度。

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Windows(WorkbookNameOld).Worksheets("WorksheetName").Range("NamedRange01").Copy
Windows(WorkbookNameNew).ActiveSheet.Range("NamedRange01").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

VBA Excel-如何将工作簿B中命名范围的值转换为工作簿A中相同/相似的命名范围？

1 个答案: