Хитрости »
6 Май 2011 261632 просмотров
Как получить данные из закрытой книги?
Достаточно часто появляется вопрос: как извлечь данные из закрытой книги Excel через VBA? Звучит может быть странновато, но это так: вопрос регулярно поднимается на форумах. Собственно, именно в связи с этим и появилась на свет данная статья. В принципе ничего сложного в задаче нет. При этом получить данные можно разными способами, в том числе при помощи функций пользователя(UDF).
Хотя если вдаваться в технические подробности, то получить данные из закрытой книги вообще нельзя. Так или иначе, на уровне системы файл все равно открывается, различие лишь в том как именно и к чему при этом предоставляется доступ. Поэтому переозвучим классическую постановку задачи в более распространенную в жизни: «Как получить данные из книги, не открывая её так, чтобы об этом узнал пользователь»
Попробуем разобраться с некоторыми методами, их плюсами и минусами:
- Получение данных из закрытой книги при помощи процедуры
- Получение данных из закрытой книги при помощи UDF
- Получение данных из закрытой книги при помощи запроса ADO
- Получение данных из закрытой книги при помощи Power Query
Sub Get_Value_From_Close_Book_Formula() Dim sPath As String, sFile As String, sShName As String sPath = "C:Documents and Settings" '" sFile = "Книга1.xls" '" sShName = "Лист1" '" Application.DisplayAlerts = 0 With Range("A1:A100") .Formula = "='" & sPath & "[" & sFile & "]" & sShName & "'!" & "A1" '" '"A1" - указывается начальная ячейка диапазона, из которого необходимо получить значения .Value = .Value End With Application.DisplayAlerts = 1 End Sub
Данный код работает достаточно медленно, но с его помощью можно «вытащить» из закрытой книги значения сразу нескольких ячеек. Код ниже работает быстрее, но с его помощью можно извлечь значения лишь одной ячейки:
Sub Get_Value_From_Close_Book_Excel4Macro() Dim sPath As String, sFile As String, sShName As String Dim sAddress As String, vData sPath = "C:Documents and Settings" '" sFile = "Книга1.xls" '" sShName = "Лист1" '" sAddress = "'" & sPath & "[" & sFile & "]" & sShName & "'!" & Range("A1").Address(ReferenceStyle:=xlR1C1) '" vData = ExecuteExcel4Macro(sAddress) End Sub
Если честно, сам я не очень-то люблю ни один из данных методов, т.к. они совершенно лишены гибкости. С их помощью можно получить исключительно значения ячеек. Форматы, формулы или другие свойства ячеек получить уже не получится. Поэтому я предпочитаю открывать книгу и копировать то, что мне надо. Делаю это, скрывая от пользователя при помощи свойства ScreenUpdating объекта Application.
Sub Get_Value_From_Close_Book() Dim sShName As String, sAddress As String, vData Dim objCloseBook As Workbook 'Отключаем обновление экрана Application.ScreenUpdating = False Set objCloseBook = Workbooks.Open("C:Documents and SettingsКнига1.xls") sAddress = "A1:C100" 'или одна ячейка - "A1" 'получаем значение vData = Sheets("Лист1").Range(sAddress).Value 'Записываем данные на активный лист книги, 'с которой запустили макрос 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 'вставляем форматы 'закрываем книгу(из которой получали значения) без сохранения objCloseBook.Close False 'Включаем обновление экрана Application.ScreenUpdating = True End Sub
Есть и более экзотический метод — при помощи GetObject:
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 'Записываем данные на активный лист книги, 'с которой запустили макрос 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 'вставляем форматы 'закрываем книгу(из которой получали значения) без сохранения objCloseBook.Close False 'Включаем обновление экрана Application.ScreenUpdating = True End Sub
При таком подходе пользователь разницы не увидит, а действия можно производить с ячейками разные: и сравнение, и отбор по критериям, и фильтровать, и сортировать и т.д. Плюс из книги можно переносить не только значения ячеек, но и форматы, формулы. Но выбирать метод получения значений из закрытых книг вам. Все зависит от ситуации. Все указанные коды работают. Если не работают — то проверьте верно ли указаны все исходные данные(имя книги и расширение, имя листа, путь к папке с книгой).
Тот же код, что уже был рассмотрен выше, но оформленный в виде UDF(функции пользователя):
Function Get_Value_From_Close_Book(sWb As String, sShName As String, sAddress As String) Dim vData, objCloseBook As Object Set objCloseBook = GetObject(sWb) 'получаем значение vData = objCloseBook.Sheets(sShName).Range(sAddress).Value objCloseBook.Close False Set objCloseBook = Nothing 'Возвращаем данные в ячейку с функцией Get_Value_From_Close_Book = vData End Function
Синтаксис функции (вызов с листа):
=Get_Value_From_Close_Book(«C:Книга1.xls»;»Лист1″;»B1″)
sWb — полный путь до книги, данные из которой необходимо извлечь («C:Книга1.xls»)
sShName — имя листа в указанной книге, данные из которого необходимо извлечь («Лист1»)
sAddress — адрес ячейки(диапазона) данные которой необходимо получить («B1»)
Чтобы получить массив ячеек(например B1:B10), необходимо выделить необходимое количество ячеек и ввести в них эту функцию, как формулу массива.
Думаю, не надо пояснять, что любой аргумент может быть задан не статичным текстом, а ссылкой на ячейку с этим текстом. Именно в этом и преимущество использования именно функций, а не процедур.
Так же есть еще один достаточно экзотический метод получения данных из действительно закрытой книги — через ADO(ActiveX Data Objects). По сути это получение данных через запрос SQL, используя для этого технологию ADO.
'--------------------------------------------------------------------------------------- ' Procedure : Extract_Value_ADO ' DateTime : 02.07.2014 16:47 ' Author : The_Prist(Щербаков Дмитрий) ' http://www.excel-vba.ru ' Purpose : Функция получения данных из закрытой книги при помощи ADO ' в таком виде не может быть использована вызовом с листа '--------------------------------------------------------------------------------------- Function Extract_Value_ADO(sPath As String, sFileName As String, sShName As String, sRng As String) Dim objADO_Con As Object, objRS As Object Dim sFullFileName As String, sADORng As String 'проверяем наличие слеша в пути к файлу If Right(sPath, 1) <> "" Then sPath = sPath & "" 'если ячейка только одна - меняем вид адресации на ячейка:ячейка, как того требует ADO If Range(sRng).Count = 1 Then sADORng = sRng & ":" & sRng Else sADORng = sRng End If sFullFileName = sPath & sFileName With CreateObject("ADODB.Connection") 'подключаемся к файлу .Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};ReadOnly=1;DBQ=" & sFullFileName & ";" 'извлекаем записи из указанного диапазона в objRS Set objRS = .Execute("select * FROM [" & sShName & "$" & sADORng & "]") 'выгружаем извлеченные данные на активный лист, начиная с ячейки А1 Cells(1, 1).CopyFromRecordset objRS 'Extract_Value_ADO = objRS.Fields(0).Value End With Set objRS = Nothing End Function
Вызывать эту функцию следует из другой процедуры или функции. Пример процедуры, для вызова этой функции:
'--------------------------------------------------------------------------------------- ' Procedure : Get_Value_From_Close_Book_ADO ' Purpose : Вызов функции Extract_Value_ADO '--------------------------------------------------------------------------------------- Sub Get_Value_From_Close_Book_ADO() Extract_Value_ADO ThisWorkbook.path, "Книга1.xls", "Лист1", "A1:B25" End Sub
Для вызова функции Extract_Value_ADO непосредственно с листа(в виде функции UDF) придется несколько изменить приведенный выше код функции, либо извлекать функцией значение только одной ячейки, что будет не очень экономично с точки зрения ресурсов и использование для этого ADO будет слишком неоправданным. Если кому необходимо, то для вызова функции с ячейки листа и возврата значения одной ячейки, необходимо заменить строку:
Cells(1, 1).CopyFromRecordset objRS
на такую:
Extract_Value_ADO = objRS.Fields(0).Value
Синтаксис вызова с листа в таком случае будет следующим:
=Extract_Value_ADO(«C:»; «Книга1.xls»; «Лист1»; «A1»)
Важно: если данные извлекаются только из одной ячейки, то следует указать две ячейки: А1:А2. Это особенность работы с запросами
Если же необходимо извлекать данные диапазона ячеек, то в этом случае можно применить такую функцию:
'--------------------------------------------------------------------------------------- ' Procedure : Extract_Value_ADO ' DateTime : 02.07.2014 16:47 ' Author : The_Prist(Щербаков Дмитрий) ' http://www.excel-vba.ru ' Purpose : Функция получения данных из закрытой книги при помощи ADO ' вызывается с листа как функция массива(если получаем данные с диапазона) '--------------------------------------------------------------------------------------- Function Extract_Value_ADO_Sh(sPath As String, sFileName As String, sShName As String, sRng As String) Dim objADO_Con As Object, objRS As Object Dim sFullFileName As String, sADORng As String Dim avTmp(), avRes(), li As Long, lr As Long, lc As Long 'проверяем наличие слеша в пути к файлу If Right(sPath, 1) <> "" Then sPath = sPath & "" 'если ячейка только одна - меняем вид адресации на ячейка:ячейка, как того требует ADO If Range(sRng).Count = 1 Then sADORng = sRng & ":" & sRng Else sADORng = sRng End If sFullFileName = sPath & sFileName With CreateObject("ADODB.Connection") 'подключаемся к файлу .Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};ReadOnly=1;DBQ=" & sFullFileName & ";" 'получаем кол-во строк в запросе Set objRS = .Execute("SELECT COUNT(*) FROM [" & sShName & "$" & sADORng & "]") li = objRS.Fields(0).Value 'извлекаем записи из указанного диапазона в objRS Set objRS = .Execute("SELECT * FROM [" & sShName & "$" & sADORng & "]") 'выгружаем извлеченные данные на активный лист, начиная с ячейки А1 ReDim avRes(1 To li, 1 To objRS.Fields.Count) avTmp = objRS.getrows(li, 0) 'получаем массив данных запроса For lr = 0 To li - 1 'цикл по строкам For lc = 0 To UBound(avTmp, 1) 'цикл по столбцам 'значения Null не допускаются, поэтому приходится их подменять до выгрузки на лист If IsNull(avTmp(lc, lr)) Then avTmp(lc, lr) = Empty End If avRes(lr + 1, lc + 1) = avTmp(lc, lr) Next lc Next lr End With Extract_Value_ADO_Sh = avRes Set objRS = Nothing End Function
Синтаксис вызова с листа точно такой же как и в функции выше, только нужно будет выделить необходимое количество ячеек и ввести в них эту функцию, как формулу массива.:
=Extract_Value_ADO_Sh(«C:»; «Книга1.xls»; «Лист1»; «A1:B10»)
sPath — путь к папке с книгой, данные из которой необходимо извлечь («C:»)
sWb — имя книги, включая расширение(.xls в примере), данные из которой необходимо извлечь («Книга1.xls»)
sShName — имя листа в указанной книге, данные из которого необходимо извлечь («Лист1»)
sAddress — адрес ячейки(диапазона) данные которой необходимо получить («A1»)
Важно: если данные извлекаются только из одной строки, то следует все равно указать минимум две строки: А1:B10. Это особенность работы с запросами. При попытке указать только одну строку А1:A10 функция вернет значение ошибки. При этом первая строка воспринимается как заголовки. Т.е. данные должны начинаться как минимум со второй строк(A2), а в A1 — заголовок
Хоть эта функция имеет определенные недостатки — она может быть в разы быстрее предыдущей.
Если еще не работали с надстройкой PowerQuery и не знаете что это такое, то для начала лучше ознакомиться со статьей: Power Query — что такое и почему её необходимо использовать в работе?
Переходим на вкладку Данные(для Excel ниже 2016 вкладка PowerQuery) —Получить данные —Из файла —Из книги
Выбираем нужный лист
Если необходимы данные всего листа, то внизу этого окна нажимаем кнопку Загрузить. Все, через пару секунд все данные выбранного листа будут помещены на новый лист текущей книги в умную таблицу.
Но если необходимо отобрать только определенные столбцы и строки — тут придется хитрить. Например, нам необходимо получить данные ячеек C2:D20, но в листе у нас заполнены ячейки A1:H89. А зачем нам лишнее? Самое простое, конечно, это диапазон C2:D20 скопировать на отдельный лист и сделать из него умную таблицу. Далее в запросе выбрать именно эту одну таблицу и все. Но. Не всегда есть такая возможность и поэтому рассмотрим более тернистый путь. Итак, мы подключились к книге. И после выбора листа выбираем не Загрузить, а Преобразовать
Попадаем в редактор запросов PowerQuery и видим там данные нашего листа. Чтобы удалить лишние строки нам придется для начала их пронумеровать, т.к. в PowerQuery нет вменяемой нумерации строк по умолчанию.
Идем на вкладку Добавление столбца —Столбец индекса —Настроить
Начальный индекс ставим 2 (2 потому что первая строка листа у нас стала заголовком, значит первая строка в запросе будет равна 2-ой строке на листе Excel и так нам будет проще потом отбирать)
Инкремент — 1 (это шаг, нам нужно просто пронумеровать строки)
Теперь раскрываем фильтр на добавленном столбце индекса —Числовые фильтры —Между
Указываем «больше или равно» — 2, «меньше или равно» — 20 (это строки нужного нам диапазона C2:D20).
После нажатия Ок останутся только нужные нам строки. А удалить столбцы проще простого: выделяем нужные нам 3-й и 4-ый столбцы(это как C и D на листе Excel, только номерами) -правая кнопка мыши —Удалить другие столбцы.
Вуаля!
Осталось выгрузить в нашу книгу: идем на вкладку Главная —Закрыть и загрузить.
В дальнейшем надо будет просто выделить любую ячейку этой полученной из PowerQuery умной таблицы правой кнопкой мыши и нажать обновить.
Правда, есть нюанс: если вдруг заголовки у нашего файла поменяются — то мы получим ошибку на шаге удаления столбцов. Это происходит потому, что PowerQuery использует абсолютные имена столбцов в запросах. Но это решаемо. Идем на вкладку Главная —Расширенный редактор:
Находим там строку:
#»Removed Other Columns» = Table.SelectColumns(#»Filtered Rows»,{«Товар», «Группа»})
Это и есть наша строка удаления всех столбцов, кроме указанных в фигурных скобках({«Товар», «Группа»}). Как видим, там жестко прописаны имена столбцов и нам надо как-то обратиться к ним через номера, чтобы не привязываться к их именами. Для этого перед этой строкой добавляем еще одну:
ColNames = Table.ColumnNames(#»Filtered Rows»),
этой строкой мы получаем список всех имен столбцов и запоминаем в список ColNames. А далее мы используем этот список для указания нужных номеров:
#»Removed Other Columns» = Table.SelectColumns(#»Filtered Rows»,{ColNames{2}, ColNames{3}})
Только необходимо обращать внимание, что здесь индексация идет с 0. Т.е. если нам нужным были столбцы С(3) и D(4), то мы указываем на 1 меньше: 2 и 3. Если столбцов будет больше — перечисляем через запятые все, которые надо оставить. Зато теперь наш запрос не зависит ни от чего и мы в итоге получаем именно то, что хотим.
И маленькая ложка дегтя: PowerQuery не очень дружелюбен к форматам файлов .xls и .xlsb. Поэтому если нет сильной необходимости использовать именно эти форматы в качестве книг, из которых надо получить данные — лучше их и не использовать.
Статья помогла? Поделись ссылкой с друзьями!
Видеоуроки
Поиск по меткам
Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика
Всё о работе с ячейками в Excel-VBA: обращение, перебор, удаление, вставка, скрытие, смена имени.
Содержание:
Table of Contents:
- Что такое ячейка Excel?
- Способы обращения к ячейкам
- Выбор и активация
- Получение и изменение значений ячеек
- Ячейки открытой книги
- Ячейки закрытой книги
- Перебор ячеек
- Перебор в произвольном диапазоне
- Свойства и методы ячеек
- Имя ячейки
- Адрес ячейки
- Размеры ячейки
- Запуск макроса активацией ячейки
2 нюанса:
- Я почти везде стараюсь использовать ThisWorkbook (а не, например, ActiveWorkbook) для обращения к текущей книге, в которой написан этот код (считаю это наиболее безопасным для новичков способом обращения к книгам, чтобы случайно не внести изменения в другие книги). Для экспериментов можете вставлять этот код в модули, коды книги, либо листа, и он будет работать только в пределах этой книги.
- Я использую английский эксель и у меня по стандарту листы называются Sheet1, Sheet2 и т.д. Если вы работаете в русском экселе, то замените Thisworkbook.Sheets(«Sheet1») на Thisworkbook.Sheets(«Лист1»). Если этого не сделать, то вы получите ошибку в связи с тем, что пытаетесь обратиться к несуществующему объекту. Можно также заменить на Thisworkbook.Sheets(1), но это менее безопасно.
Что такое ячейка Excel?
В большинстве мест пишут: «элемент, образованный пересечением столбца и строки». Это определение полезно для людей, которые не знакомы с понятием «таблица». Для того, чтобы понять чем на самом деле является ячейка Excel, необходимо заглянуть в объектную модель Excel. При этом определения объектов «ряд», «столбец» и «ячейка» будут отличаться в зависимости от того, как мы работаем с файлом.
Объекты в Excel-VBA. Пока мы работаем в Excel без углубления в VBA определение ячейки как «пересечения» строк и столбцов нам вполне хватает, но если мы решаем как-то автоматизировать процесс в VBA, то о нём лучше забыть и просто воспринимать лист как «мешок» ячеек, с каждой из которых VBA позволяет работать как минимум тремя способами:
- по цифровым координатам (ряд, столбец),
- по адресам формата А1, B2 и т.д. (сценарий целесообразности данного способа обращения в VBA мне сложно представить)
- по уникальному имени (во втором и третьем вариантах мы будем иметь дело не совсем с ячейкой, а с объектом VBA range, который может состоять из одной или нескольких ячеек). Функции и методы объектов Cells и Range отличаются. Новичкам я бы порекомендовал работать с ячейками VBA только с помощью Cells и по их цифровым координатам и использовать Range только по необходимости.
Все три способа обращения описаны далее
Как это хранится на диске и как с этим работать вне Excel? С точки зрения хранения и обработки вне Excel и VBA. Сделать это можно, например, сменив расширение файла с .xls(x) на .zip и открыв этот архив.
Пример содержимого файла Excel:
Далее xl -> worksheets и мы видим файл листа
Содержимое файла:
То же, но более наглядно:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x14ac xr xr2 xr3" xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac" xmlns:xr="http://schemas.microsoft.com/office/spreadsheetml/2014/revision" xmlns:xr2="http://schemas.microsoft.com/office/spreadsheetml/2015/revision2" xmlns:xr3="http://schemas.microsoft.com/office/spreadsheetml/2016/revision3" xr:uid="{00000000-0001-0000-0000-000000000000}">
<dimension ref="B2:F6"/>
<sheetViews>
<sheetView tabSelected="1" workbookViewId="0">
<selection activeCell="D12" sqref="D12"/>
</sheetView>
</sheetViews>
<sheetFormatPr defaultRowHeight="14.4" x14ac:dyDescent="0.3"/>
<sheetData>
<row r="2" spans="2:6" x14ac:dyDescent="0.3">
<c r="B2" t="s">
<v>0</v>
</c>
</row>
<row r="3" spans="2:6" x14ac:dyDescent="0.3">
<c r="C3" t="s">
<v>1</v>
</c>
</row>
<row r="4" spans="2:6" x14ac:dyDescent="0.3">
<c r="D4" t="s">
<v>2</v>
</c>
</row>
<row r="5" spans="2:6" x14ac:dyDescent="0.3">
<c r="E5" t="s">
<v>0</v></c>
</row>
<row r="6" spans="2:6" x14ac:dyDescent="0.3">
<c r="F6" t="s"><v>3</v>
</c></row>
</sheetData>
<pageMargins left="0.7" right="0.7" top="0.75" bottom="0.75" header="0.3" footer="0.3"/>
</worksheet>Как мы видим, в структуре объектной модели нет никаких «пересечений». Строго говоря рабочая книга — это архив структурированных данных в формате XML. При этом в каждую «строку» входит «столбец», и в нём в свою очередь прописан номер значения данного столбца, по которому оно подтягивается из другого XML файла при открытии книги для экономии места за счёт отсутствия повторяющихся значений. Почему это важно. Если мы захотим написать какой-то обработчик таких файлов, который будет напрямую редактировать данные в этих XML, то ориентироваться надо на такую модель и структуру данных. И правильное определение будет примерно таким: ячейка — это объект внутри столбца, который в свою очередь находится внутри строки в файле xml, в котором хранятся данные о содержимом листа.
Способы обращения к ячейкам
Выбор и активация
Почти во всех случаях можно и стоит избегать использования методов Select и Activate. На это есть две причины:
- Это лишь имитация действий пользователя, которая замедляет выполнение программы. Работать с объектами книги можно напрямую без использования методов Select и Activate.
- Это усложняет код и может приводить к неожиданным последствиям. Каждый раз перед использованием Select необходимо помнить, какие ещё объекты были выбраны до этого и не забывать при необходимости снимать выбор. Либо, например, в случае использования метода Select в самом начале программы может быть выбрано два листа вместо одного потому что пользователь запустил программу, выбрав другой лист.
Можно выбирать и активировать книги, листы, ячейки, фигуры, диаграммы, срезы, таблицы и т.д.
Отменить выбор ячеек можно методом Unselect:
Selection.UnselectОтличие выбора от активации — активировать можно только один объект из раннее выбранных. Выбрать можно несколько объектов.
Если вы записали и редактируете код макроса, то лучше всего заменить Select и Activate на конструкцию With … End With. Например, предположим, что мы записали вот такой макрос:
Sub Macro1()
' Macro1 Macro
Range("F4:F10,H6:H10").Select 'выбрали два несмежных диапазона зажав ctrl
Range("H6").Activate 'показывает только то, что я начал выбирать второй диапазон с этой ячейки (она осталась белой). Это действие ни на что не влияет
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535 'залили желтым цветом, нажав на кнопку заливки на верхней панели
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End SubПочему макрос записался таким неэффективным образом? Потому что в каждый момент времени (в каждой строке) программа не знает, что вы будете делать дальше. Поэтому в записи выбор ячеек и действия с ними — это два отдельных действия. Этот код лучше всего оптимизировать (особенно если вы хотите скопировать его внутрь какого-нибудь цикла, который должен будет исполняться много раз и перебирать много объектов). Например, так:
Sub Macro11()
'
' Macro1 Macro
Range("F4:F10,H6:H10").Select '1. смотрим, что за объект выбран (что идёт до .Select)
Range("H6").Activate
With Selection.Interior '2. понимаем, что у выбранного объекта есть свойство interior, с которым далее идёт работа
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub Optimized_Macro()
With Range("F4:F10,H6:H10").Interior '3. переносим объект напрямую в конструкцию With вместо Selection
' ////// Здесь я для надёжности прописал бы ещё Thisworkbook.Sheet("ИмяЛиста") перед Range,
' ////// чтобы минимизировать риск любых случайных изменений других листов и книг
' ////// With Thisworkbook.Sheet("ИмяЛиста").Range("F4:F10,H6:H10").Interior
.Pattern = xlSolid '4. полностью копируем всё, что было записано рекордером внутрь блока with
.PatternColorIndex = xlAutomatic
.Color = 55555 '5. здесь я поменял цвет на зеленый, чтобы было видно, работает ли код при поочерёдном запуске двух макросов
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End SubПример сценария, когда использование Select и Activate оправдано:
Допустим, мы хотим, чтобы во время исполнения программы мы одновременно изменяли несколько листов одним действием и пользователь видел какой-то определённый лист. Это можно сделать примерно так:
Sub Select_Activate_is_OK()
Thisworkbook.Worksheets(Array("Sheet1", "Sheet3")).Select 'Выбираем несколько листов по именам
Thisworkbook.Worksheets("Sheet3").Activate 'Показываем пользователю третий лист
'Далее все действия с выбранными ячейками через Select будут одновременно вносить изменения в оба выбранных листа
'Допустим, что тут мы решили покрасить те же два диапазона:
Range("F4:F10,H6:H10").Select
Range("H6").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End SubЕдинственной причиной использовать этот код по моему мнению может быть желание зачем-то показать пользователю определённую страницу книги в какой-то момент исполнения программы. С точки зрения обработки объектов, опять же, эти действия лишние.
Получение и изменение значений ячеек
Значение ячеек можно получать/изменять с помощью свойства value.
'Если нужно прочитать / записать значение ячейки, то используется свойство Value
a = ThisWorkbook.Sheets("Sheet1").Cells (1,1).Value 'записать значение ячейки А1 листа "Sheet1" в переменную "a"
ThisWorkbook.Sheets("Sheet1").Cells (1,1).Value = 1 'задать значение ячейки А1 (первый ряд, первый столбец) листа "Sheet1"
'Если нужно прочитать текст как есть (с форматированием), то можно использовать свойство .text:
ThisWorkbook.Sheets("Sheet1").Cells (1,1).Text = "1"
a = ThisWorkbook.Sheets("Sheet1").Cells (1,1).Text
'Когда проявится разница:
'Например, если мы считываем дату в формате "31 декабря 2021 г.", хранящуюся как дата
a = ThisWorkbook.Sheets("Sheet1").Cells (1,1).Value 'эапишет как "31.12.2021"
a = ThisWorkbook.Sheets("Sheet1").Cells (1,1).Text 'запишет как "31 декабря 2021 г."Ячейки открытой книги
К ячейкам можно обращаться:
'В книге, в которой хранится макрос (на каком-то из листов, либо в отдельном модуле или форме)
ThisWorkbook.Sheets("Sheet1").Cells(1,1).Value 'По номерам строки и столбца
ThisWorkbook.Sheets("Sheet1").Cells(1,"A").Value 'По номерам строки и букве столбца
ThisWorkbook.Sheets("Sheet1").Range("A1").Value 'По адресу - вариант 1
ThisWorkbook.Sheets("Sheet1").[A1].Value 'По адресу - вариант 2
ThisWorkbook.Sheets("Sheet1").Range("CellName").Value 'По имени ячейки (для этого ей предварительно нужно его присвоить)
'Те же действия, но с использованием полного названия рабочей книги (книга должна быть открыта)
Workbooks("workbook.xlsm").Sheets("Sheet1").Cells(1,1).Value 'По номерам строки и столбца
Workbooks("workbook.xlsm").Sheets("Sheet1").Cells(1,"A").Value 'По номерам строки и букве столбца
Workbooks("workbook.xlsm").Sheets("Sheet1").Range("A1").Value 'По адресу - вариант 1
Workbooks("workbook.xlsm").Sheets("Sheet1").[A1].Value 'По адресу - вариант 2
Workbooks("workbook.xlsm").Sheets("Sheet1").Range("CellName").Value 'По имени ячейки (для этого ей предварительно нужно его присвоить)
Ячейки закрытой книги
Если нужно достать или изменить данные в другой закрытой книге, то необходимо прописать открытие и закрытие книги. Непосредственно работать с закрытой книгой не получится, потому что данные в ней хранятся отдельно от структуры и при открытии Excel каждый раз производит расстановку значений по соответствующим «слотам» в структуре. Подробнее о том, как хранятся данные в xlsx см выше.
Workbooks.Open Filename:="С:closed_workbook.xlsx" 'открыть книгу (она становится активной)
a = ActiveWorkbook.Sheets("Sheet1").Cells(1,1).Value 'достать значение ячейки 1,1
ActiveWorkbook.Close False 'закрыть книгу (False => без сохранения)Скачать пример, в котором можно посмотреть, как доставать и как записывать значения в закрытую книгу.
Код из файла:
Option Explicit
Sub get_value_from_closed_wb() 'достать значение из закрытой книги
Dim a, wb_path, wsh As String
wb_path = ThisWorkbook.Sheets("Sheet1").Cells(2, 3).Value 'get path to workbook from sheet1
wsh = ThisWorkbook.Sheets("Sheet1").Cells(3, 3).Value
Workbooks.Open Filename:=wb_path
a = ActiveWorkbook.Sheets(wsh).Cells(3, 3).Value
ActiveWorkbook.Close False
ThisWorkbook.Sheets("Sheet1").Cells(4, 3).Value = a
End Sub
Sub record_value_to_closed_wb() 'записать значение в закрытую книгу
Dim wb_path, b, wsh As String
wsh = ThisWorkbook.Sheets("Sheet1").Cells(3, 3).Value
wb_path = ThisWorkbook.Sheets("Sheet1").Cells(2, 3).Value 'get path to workbook from sheet1
b = ThisWorkbook.Sheets("Sheet1").Cells(5, 3).Value 'get value to record in the target workbook
Workbooks.Open Filename:=wb_path
ActiveWorkbook.Sheets(wsh).Cells(4, 4).Value = b 'add new value to cell D4 of the target workbook
ActiveWorkbook.Close True
End SubПеребор ячеек
Перебор в произвольном диапазоне
Скачать файл со всеми примерами
Пройтись по всем ячейкам в нужном диапазоне можно разными способами. Основные:
- Цикл For Each. Пример:
Sub iterate_over_cells() For Each c In ThisWorkbook.Sheets("Sheet1").Range("B2:D4").Cells MsgBox (c) Next c End SubЭтот цикл выведет в виде сообщений значения ячеек в диапазоне B2:D4 по порядку по строкам слева направо и по столбцам — сверху вниз. Данный способ можно использовать для действий, в который вам не важны номера ячеек (закрашивание, изменение форматирования, пересчёт чего-то и т.д.).
- Ту же задачу можно решить с помощью двух вложенных циклов — внешний будет перебирать ряды, а вложенный — ячейки в рядах. Этот способ я использую чаще всего, потому что он позволяет получить больше контроля над исполнением: на каждой итерации цикла нам доступны координаты ячеек. Для перебора всех ячеек на листе этим методом потребуется найти последнюю заполненную ячейку. Пример кода:
Sub iterate_over_cells() Dim cl, rw As Integer Dim x As Variant 'перебор области 3x3 For rw = 1 To 3 ' цикл для перебора рядов 1-3 For cl = 1 To 3 'цикл для перебора столбцов 1-3 x = ThisWorkbook.Sheets("Sheet1").Cells(rw + 1, cl + 1).Value MsgBox (x) Next cl Next rw 'перебор всех ячеек на листе. Последняя ячейка определена с помощью UsedRange 'LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 'LastCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1 'For rw = 1 To LastRow 'цикл перебора всех рядов ' For cl = 1 To LastCol 'цикл для перебора всех столбцов ' Действия ' Next cl 'Next rw End Sub - Если нужно перебрать все ячейки в выделенном диапазоне на активном листе, то код будет выглядеть так:
Sub iterate_cell_by_cell_over_selection() Dim ActSheet As Worksheet Dim SelRange As Range Dim cell As Range Set ActSheet = ActiveSheet Set SelRange = Selection 'if we want to do it in every cell of the selected range For Each cell In Selection MsgBox (cell.Value) Next cell End SubДанный метод подходит для интерактивных макросов, которые выполняют действия над выбранными пользователем областями.
- Перебор ячеек в ряду
Sub iterate_cells_in_row() Dim i, RowNum, StartCell As Long RowNum = 3 'какой ряд StartCell = 0 ' номер начальной ячейки (минус 1, т.к. в цикле мы прибавляем i) For i = 1 To 10 ' 10 ячеек в выбранном ряду ThisWorkbook.Sheets("Sheet1").Cells(RowNum, i + StartCell).Value = i '(i + StartCell) добавляет 1 к номеру столбца при каждом повторении Next i End Sub - Перебор ячеек в столбце
Sub iterate_cells_in_column() Dim i, ColNum, StartCell As Long ColNum = 3 'какой столбец StartCell = 0 ' номер начальной ячейки (минус 1, т.к. в цикле мы прибавляем i) For i = 1 To 10 ' 10 ячеек ThisWorkbook.Sheets("Sheet1").Cells(i + StartCell, ColNum).Value = i ' (i + StartCell) добавляет 1 к номеру ряда при каждом повторении Next i End Sub
Свойства и методы ячеек
Имя ячейки
Присвоить новое имя можно так:
Thisworkbook.Sheets(1).Cells(1,1).name = "Новое_Имя"Для того, чтобы сменить имя ячейки нужно сначала удалить существующее имя, а затем присвоить новое. Удалить имя можно так:
ActiveWorkbook.Names("Старое_Имя").DeleteПример кода для переименования ячеек:
Sub rename_cell()
old_name = "Cell_Old_Name"
new_name = "Cell_New_Name"
ActiveWorkbook.Names(old_name).Delete
ThisWorkbook.Sheets(1).Cells(2, 1).Name = new_name
End Sub
Sub rename_cell_reverse()
old_name = "Cell_New_Name"
new_name = "Cell_Old_Name"
ActiveWorkbook.Names(old_name).Delete
ThisWorkbook.Sheets(1).Cells(2, 1).Name = new_name
End SubАдрес ячейки
Sub get_cell_address() ' вывести адрес ячейки в формате буква столбца, номер ряда
'$A$1 style
txt_address = ThisWorkbook.Sheets(1).Cells(3, 2).Address
MsgBox (txt_address)
End Sub
Sub get_cell_address_R1C1()' получить адрес столбца в формате номер ряда, номер столбца
'R1C1 style
txt_address = ThisWorkbook.Sheets(1).Cells(3, 2).Address(ReferenceStyle:=xlR1C1)
MsgBox (txt_address)
End Sub
'пример функции, которая принимает 2 аргумента: название именованного диапазона и тип желаемого адреса
'(1- тип $A$1 2- R1C1 - номер ряда, столбца)
Function get_cell_address_by_name(str As String, address_type As Integer)
'$A$1 style
Select Case address_type
Case 1
txt_address = Range(str).Address
Case 2
txt_address = Range(str).Address(ReferenceStyle:=xlR1C1)
Case Else
txt_address = "Wrong address type selected. 1,2 available"
End Select
get_cell_address_by_name = txt_address
End Function
'перед запуском нужно убедиться, что в книге есть диапазон с названием,
'адрес которого мы хотим получить, иначе будет ошибка
Sub test_function() 'запустите эту программу, чтобы увидеть, как работает функция
x = get_cell_address_by_name("MyValue", 2)
MsgBox (x)
End SubРазмеры ячейки
Ширина и длина ячейки в VBA меняется, например, так:
Sub change_size()
Dim x, y As Integer
Dim w, h As Double
'получить координаты целевой ячейки
x = ThisWorkbook.Sheets("Sheet1").Cells(2, 2).Value
y = ThisWorkbook.Sheets("Sheet1").Cells(3, 2).Value
'получить желаемую ширину и высоту ячейки
w = ThisWorkbook.Sheets("Sheet1").Cells(6, 2).Value
h = ThisWorkbook.Sheets("Sheet1").Cells(7, 2).Value
'сменить высоту и ширину ячейки с координатами x,y
ThisWorkbook.Sheets("Sheet1").Cells(x, y).RowHeight = h
ThisWorkbook.Sheets("Sheet1").Cells(x, y).ColumnWidth = w
End SubПрочитать значения ширины и высоты ячеек можно двумя способами (однако результаты будут в разных единицах измерения). Если написать просто Cells(x,y).Width или Cells(x,y).Height, то будет получен результат в pt (привязка к размеру шрифта).
Sub get_size()
Dim x, y As Integer
'получить координаты ячейки, с которой мы будем работать
x = ThisWorkbook.Sheets("Sheet1").Cells(2, 2).Value
y = ThisWorkbook.Sheets("Sheet1").Cells(3, 2).Value
'получить длину и ширину выбранной ячейки в тех же единицах измерения, в которых мы их задавали
ThisWorkbook.Sheets("Sheet1").Cells(2, 6).Value = ThisWorkbook.Sheets("Sheet1").Cells(x, y).ColumnWidth
ThisWorkbook.Sheets("Sheet1").Cells(3, 6).Value = ThisWorkbook.Sheets("Sheet1").Cells(x, y).RowHeight
'получить длину и ширину с помощью свойств ячейки (только для чтения) в поинтах (pt)
ThisWorkbook.Sheets("Sheet1").Cells(7, 9).Value = ThisWorkbook.Sheets("Sheet1").Cells(x, y).Width
ThisWorkbook.Sheets("Sheet1").Cells(8, 9).Value = ThisWorkbook.Sheets("Sheet1").Cells(x, y).Height
End SubСкачать файл с примерами изменения и чтения размера ячеек
Запуск макроса активацией ячейки
Для запуска кода VBA при активации ячейки необходимо вставить в код листа нечто подобное:
3 важных момента, чтобы это работало:
1. Этот код должен быть вставлен в код листа (здесь контролируется диапазон D4)
2-3. Программа, ответственная за запуск кода при выборе ячейки, должна называться Worksheet_SelectionChange и должна принимать значение переменной Target, относящейся к триггеру SelectionChange. Другие доступные триггеры можно посмотреть в правом верхнем углу (2).
Скачать файл с базовым примером (как на картинке)
Скачать файл с расширенным примером (код ниже)
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' имеем в виду, что триггер SelectionChange будет запускать эту Sub после каждого клика мышью (после каждого клика будет проверяться:
'1. количество выделенных ячеек и
'2. не пересекается ли выбранный диапазон с заданным в этой программе диапазоном.
' поэтому в эту программу не стоит без необходимости писать никаких других тяжелых операций
If Selection.Count = 1 Then 'запускаем программу только если выбрано не более 1 ячейки
'вариант модификации - брать адрес ячейки из другой ячейки:
'Dim CellName as String
'CellName = Activesheet.Cells(1,1).value 'брать текстовое имя контролируемой ячейки из A1 (должно быть в формате Буква столбца + номер строки)
'If Not Intersect(Range(CellName), Target) Is Nothing Then
'для работы этой модификации следующую строку надо закомментировать/удалить
If Not Intersect(Range("D4"), Target) Is Nothing Then
'если заданный (D4) и выбранный диапазон пересекаются
'(пересечение диапазонов НЕ равно Nothing)
'можно прописать диапазон из нескольких ячеек:
'If Not Intersect(Range("D4:E10"), Target) Is Nothing Then
'можно прописать несколько диапазонов:
'If Not Intersect(Range("D4:E10"), Target) Is Nothing or Not Intersect(Range("A4:A10"), Target) Is Nothing Then
Call program 'выполняем программу
End If
End If
End Sub
Sub program()
MsgBox ("Program Is running") 'здесь пишем код того, что произойдёт при выборе нужной ячейки
End Sub
Yes you can do this using ADO as Gary commented but only if your Excel Worksheet is arranged in a Database like structure.
Meaning you have valid fields arranged in columns (with or without headers).
For example:
Now, you see that ID number 12345 have a name John John and you want to update it to John Knight.
Using ADO you can try:
Edit1: You can actually do this without using Recordset. See below update.
Sub conscious()
Dim con As ADODB.Connection
Dim sqlstr As String, datasource As String
Set con = New ADODB.Connection
datasource = "C:UsersUserNameDesktopTestDataBase.xlsx" 'change to suit
Dim sconnect As String
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & datasource & ";" & _
"Extended Properties=""Excel 12.0;HDR=YES"";"
With con
.Open sconnect
sqlstr = "UPDATE [Sheet1$] SET [Name] = ""John Knight"" WHERE [ID Number] = 12345"
.Execute sqlstr
.Close
End With
Set con = Nothing
End Sub
Result:
I’m not entirely sure if this is what you want but HTH.
Notes:
- You need to add reference to Microsoft ActiveX Data Objects X.X Library (early bind).
- But you can also do this using late bind (no reference).
- Connection string used is for Excel 2007 and up.
- Sheet1 is the name of the target sheet you want to update the value to.
Edit1: This is how to do it if your file have no header
First change the connection string HDR argument to NO:.
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & datasource & ";" & _
"Extended Properties=""Excel 12.0;HDR=NO"";"
Then adjust your SQL string to:
sqlstr = "UPDATE [Sheet1$] SET F2 = ""John Knight"" WHERE F1 = 12345"
So that is F1 for field 1, F2 for field 2 etc.
Fedogor, так вряд ли получится, потому что здесь еще есть предыстория.
Есть папка. В ней много подпапок. Во всех этих подпапках лежат .xls файлы одного шаблона. И эти файлы добавляются, точно так же, как и папки. И когда-то на этом форуме один очень добрый человек помог мне написать макрос, который находит все эти файлы.
И всё было бы хорошо, но в силу того, что я знаю vba так, как третьеклассник знает математику, я не могу дописать этот макрос так, чтоб достать из этих файлов необходимые данные.
Суть в том, чтоб из многих файлов, которые добавляются и обновляются, создать небольшую базу данных. К примеру, в каждом таком файле в одной определённой ячейке есть имя клиента, во второй количество купленного товара и в третьей цена товара. И эти данные из файлов по разным клиентам нужно свести в одну табличку в отдельной книге.
Ниже приведены две процедуры (спасибо, Аналитика), которые находят все .xls файлы во всех папках первого уровня вложения, и заносят в столбец А пути ко всем файлам. Список этих файлов на рабочем листе мне, по сути, не нужен, было бы лучше, если бы пути к этим файлам просто сохранялись в памяти программы. И дальше мне нужен только пример того, как из каждой этих рабочих книг достать значение какой-то одной ячейки и вставить его в активную рабочую книгу в столбик.
| Visual Basic | ||
|
Функция GetValue предназначена для получения данных из закрытой книги Excel
Использовать такой способ имеет смысл только в том случае, если из большого файла надо получить значения только нескольких ячеек (или одного диапазона ячеек), и при этом точно известно расположение на листе интересующих нас ячеек, и имена листов
Пример использования функции:
Sub ПримерИспользования_GetValue() p = "C:Documents and SettingsБухгалтерия" ' папка с файлом f = "расход.xls" ' имя файла s = "доходы" ' название листа a = "D145" ' интересующая нас ячейка ' выполняем загрузку данных из закрытой книги Excel ЗначениеЯчейки = GetValue(p, f, s, a) Debug.Print ЗначениеЯчейки ' выводим результат в окно Immediate End Sub
Код функции GetValue:
Function GetValue(path, file, sheet, ref) 'Функция GetValue получает в качестве параметров: ' path – путь к закрытому файлу (например, "d:files"); ' file – название рабочей книги (например, "budget.xls"); ' sheet – название рабочего листа (например, "Лист1"); ' ref – ссылка на ячейку (например, "C4"). If Right(path, 1) <> "" Then path = path & "" ' проверяем наличие файла по заданному пути If Dir(path & file) = "" Then GetValue = "Файл не найден": Exit Function ' формируем строку запроса arg$ = "'" & path & "[" & file & "]" & sheet & "'!" & _ Range(ref).Range("A1").Address(, , xlR1C1) ' считываем значение из закрытой книги GetValue = ExecuteExcel4Macro(arg$) ' вместо ошибки возвращаем сообщение об ошибке ' к примеру, если лист не найден, или указана несуществующая ячейка If IsError(GetValue) Then GetValue = "<ошибка>" End Function
Ещё один вариант этой функции:
Function GetValue(ByVal filepath$, ByVal SheetName$, ByVal CellAddress$) 'Функция GetValue получает в качестве параметров: ' filepath$ = полный путь к файлу Excel (например, "d:filesbudget.xls"); ' SheetName$ – название рабочего листа (например, "Лист1"); ' CellAddress$ – ссылка на ячейку (например, "C4"). On Error Resume Next ' проверяем наличие файла по заданному пути If Dir(filepath$) = "" Then GetValue = "Файл не найден": Exit Function Dim arr arr = Split(filepath$, "") arr(UBound(arr)) = "[" & arr(UBound(arr)) & "]" filepath$ = Join(arr, "") ' формируем строку запроса arg$ = "'" & filepath$ & SheetName$ & "'!" & Range(CellAddress$).Range("A1").Address(, , xlR1C1) ' считываем значение из закрытой книги GetValue = ExecuteExcel4Macro(arg$) ' вместо ошибки возвращаем сообщение об ошибке ' к примеру, если лист не найден, или указана несуществующая ячейка If IsError(GetValue) Then GetValue = "<ошибка>" End Function