Страницы: 1
RSS
Копирование конкретных ячеек из закрытой книги
 
Здравствуйте. Нужна Ваша помощь, вообщем я нашел макрос в интернете который копирует данные из закрытой книги, но он получается копирует диапазон, а мне надо, чтобы копировал нужные мне ячейки ("A3","C5","H4", G8"). Вот ссылка на макрос КАК ПОЛУЧИТЬ ДАННЫЕ ИЗ ЗАКРЫТОЙ КНИГИ. Я его не много переделал, вот что получилось:
Код
Sub Копировать_ИЗ()
    Dim sShName As String, sAddress As String, vData
    Dim objCloseBook As Object
    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    Set objCloseBook = GetObject("D:\Сюда.xlsm")
    vData = objCloseBook.Sheets("Поиск").Range("A3","C5","H4", "G8").Value
    objCloseBook.Close False
    If IsArray(vData) Then
        Sheets("Лист1").Range("A3","C5","H4", "G8").Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
    Else
        Sheets("Поиск").Range("A3","C5","H4", G8") = vData
    End If
    Application.ScreenUpdating = True
End Sub
Но когда я прописываю в макросе вот так:
Код
.Range("A3","C5")
то он копирует, а когда так:
Код
.Range("A3","C5","H4", "G8")
То выдает ошибку. Где мне прописать нужное количество ячеек, для копирования???
Изменено: Deniska3 - 15.01.2020 15:50:14
 
Вам форум ошибку уже подсветил.
 
найдите два отличия
Цитата
Deniska3 написал:
"H4"
и
Цитата
Deniska3 написал:
G8"
красным так сказать намекнул
Изменено: Mershik - 15.01.2020 15:33:51
Не бойтесь совершенства. Вам его не достичь.
 
Это опечатка,
Код
Sub Копировать_ИЗ()
    Dim sShName As String, sAddress As String, vData
    Dim objCloseBook As Object
    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    Set objCloseBook = GetObject("D:\Сюда.xlsm")
    vData = objCloseBook.Sheets("Поиск").Range("A3", "C5", "H4", "G8").Value
    objCloseBook.Close False
    If IsArray(vData) Then
        Sheets("Лист1").Range("A3", "C5", "H4", "G8").Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
    Else
        Sheets("Поиск").Range("A3", "C5", "H4", "G8") = vData
    End If
    Application.ScreenUpdating = True
End Sub
все равно выдает ошибку
Код
vData = objCloseBook.Sheets("Поиск").Range("A3", "C5", "H4", "G8").Value
Изменено: Deniska3 - 15.01.2020 15:44:57
 
Вот пример
 
Если, что вот оригинал этого макроса
Код
Sub Get_Value_From_Close_Book2()
    Dim sShName As String, sAddress As String, vData
    Dim objCloseBook As Object
    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    Set objCloseBook = GetObject("C:\Documents and Settings\Книга1.xls")
    sAddress = "A1:C100" 'или одна ячейка - "A1"
    'получаем значение
    vData = objCloseBook.Sheets("Лист1").Range(sAddress).Value
    objCloseBook.Close False
    'Записываем данные на активный лист книги,
    'с которой запустили макрос
    If IsArray(vData) Then
        [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
    Else
        [A1] = vData
    End If
    'если надо копировать ячейки с форматами, 
    'то можно использовать стандартные методы копирования вставки
    'objCloseBook.Sheets("Лист1").Range(sAddress).Copy
    '[A1].PasteSpecial xlPasteValues  'вставляем значения
    '[A1].PasteSpecial xlPasteFormats 'вставляем форматы
    'Включаем обновление экрана
    Application.ScreenUpdating = True
End Sub
Изменено: Deniska3 - 15.01.2020 17:12:06
 
Цитата
Deniska3 написал:
Sheets("Поиск").Range("A3", "C5", "H4", "G8") = vData
так нельзя, потому что невозможно применить эту команду к несвязанным диапазонам. Хоть из закрытой книги, хоть из открытой. Надо переносить их поячеечно.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Кажется понял.
Код
vData = objCloseBook.Sheets("Поиск").Range("A3","C5","H4", "G8").Value

не применимо для несвязанных диапазонов.
В случае, когда диапазон имеет 2 ячейки, он преобразуется в непрерывный диапазон с адресом, ограниченным этими ячейками
Код
Range("A3","C5") >>> Range("A3:C5")

и ошибки не возникает.
 
Если ячейки конкретные - берите конкретной ссылкой, это самое простое. И не нужно книгу открывать.
 
RAN, получается Вы мне предоставили код только для двух ячеек? а надо для большего количества. Я не понял как воспользоваться Вашим кодом.
Изменено: Deniska3 - 15.01.2020 20:08:33
 
Я не предоставлял никакой код. Я продемонстрировал, как из 2 ячеек получается 9.
 
Я так понимаю помощи ни будет :(  
 
Цитата
Deniska3 написал:
Я так понимаю помощи ни будет
Вам помогли: подсказали что надо сделать, чтобы заработало. У Вас это видимо не получилось, а здесь никто не обязан писать Вам код под конкретно Вашу задачу. По сути надо просто сделать цикличный перенос информации из каждой ячейки отдельно(о чем я упоминал уже). При этом Вам правильно написали, что быстрее будет забирать данные ссылками(в статье по Вашей ссылке этот метод описан). Но раз хочется именно путем открытия книги, то делайте так:
Код
Sub Get_Value_From_Close_Book2()
    Dim sShName As String, vData
    Dim objCloseBook As Object
    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    Set objCloseBook = GetObject("C:\Documents and Settings\Книга1.xls")
    Dim x
    For each x in array("A3","C5","H4", "G8")
        'Записываем данные на активный лист книги,
        'с которой запустили макрос
        Range(x).Value = objCloseBook.Sheets("Лист1").Range(x).Value
    Next
    objCloseBook.Close False
    'Включаем обновление экрана
    Application.ScreenUpdating = True
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
А как прописать в какие ячейки вставлять?
 
Т.е. Вы пример приложили от балды? У Вас в примере ячейки для вставки те же, что и для копирования. Код основан на этом. Если надо вставлять в какие-то другие ячейки и коды сами подправить не можете - будьте любезны озвучить в какие именно ячейки, являются ли они постоянными и т.д. А то в примере кода одно указываете, а в качестве решения что-то другое ждете...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Ах да, извините.  ("A3","C5","H4", "G8"), в ("A8","C8","H8", "G16")
 
Создайте ДВА массива, перебирайте одновременно оба по индексу х.
 
Код
Sub Get_Value_From_Close_Book2()
    Dim sShName As String, vData
    Dim objCloseBook As Object
    Dim aCopy, aPaste,lr&
    aCopy = array("A3","C5","H4", "G8")     'кол-во ячеек должно быть равно кол-ву в aPaste
    aPaste = array("A8","C8","H8", "G16")  'кол-во ячеек должно быть равно кол-ву в aCopy
    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    Set objCloseBook = GetObject("C:\Documents and Settings\Книга1.xls")
    For lr = lbound(aCopy) to ubound(aCopy)
        'Записываем данные на активный лист книги,
        'с которой запустили макрос
        Range(aCopy(lr)).Value = objCloseBook.Sheets("Лист1").Range(aPaste(lr)).Value
    Next
    objCloseBook.Close False
    'Включаем обновление экрана
    Application.ScreenUpdating = True
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, как всегда грамотный ответ. Спасибо Вам большое!!!
Страницы: 1
Наверх