VBA Excel - Как перенести значения именованных диапазонов из рабочей книги B в одинаковые / похожие именованные диапазоны в рабочей книге A? - PullRequest
Новая
       15

VBA Excel - Как перенести значения именованных диапазонов из рабочей книги B в одинаковые / похожие именованные диапазоны в рабочей книге A?

0 голосов
/ 16 сентября 2018

Заранее благодарю за любую помощь. Мои знания начального уровня. Я могу читать код, но не могу писать.

Кроме того, я предполагаю, что всегда есть лучший (более эффективный) способ написания кода.

Решение представляет собой сочетание нескольких целей:
1. Командная кнопка с назначенным макросом (готово)
2. Обработка ошибок (для этого есть небольшой код)
3. Определите вторую рабочую книгу для передачи (укажите код для этого)
4. Скопируйте и вставьте значения из 90+ именованных диапазонов в рабочую книгу A (код пещерного человека с помощью макро-рекордера)
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

Приношу свои извинения, если интервалы, отступы и комментарии не оптимизированы для чтения. Я все еще изучаю лучшие практики.

Обратите внимание: некоторые диапазоны имен пишутся по-разному, и мне нужно отобразить их так, чтобы копирование / вставка была точной.

Кроме того, вместо использования копирования / вставки не лучше ли перечислить все именованные диапазоны в массиве со связанными переменными? И не лучше ли скопировать все значения и объекты в массив, а затем переключиться на книгу A и вставить весь контент?

Еще раз спасибо за вашу помощь.

1 Ответ

0 голосов
/ 16 сентября 2018

Вам не нужно беспокоиться об активации рабочей книги или листов перед копированием или вставкой. Это просто замедляет ход событий. Кроме того, вы можете включить обновление экрана и калькуляцию, чтобы ускорить процесс. 

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
...