Работа с диапазонами ячеек и листами
Функция GetQueryRange предназначена для автоматизации загрузки данных с веб-страниц.Например, нам надо из макроса Excel получить данные с нескольких однотипных страниц сайта. Самый простой способ достичь этого - выполнять почти идентичные веб-запросы (где незначительно отличаться будет только URL страницы), Поскольку количество обращений ко мне, с просьбами сделать программу загрузки данных из интернета, с каждым днём растёт, я решил сделать для этих целей универсальную функцию:
Sub ПримерИспользования() Dim ra As Range: On Error Resume Next Set ra = GetQueryRange("http://ExcelVBA.ru/", 6) Debug.Print ra.Address ' переменная ra содержит ссылку на диапазон ячеек $A$1:$C$15, ' содержащий данные 6-й таблицы главной страницы сайта ExcelVBA.ru Set ra = GetQueryRange("http://excelvba.ru/sitemap.xml") Debug.Print ra.Address ' теперь переменная ra содержит ссылку на диапазон ячеек $A$1:$D$502, ' содержащий данные карты сайта ExcelVBA.ru End Sub
|
|||
Макрос предназначен для поиска текста из выделенных ячеек в поисковой системе Google.Функция поиска доступна из контекстного меню ячеек:
Как вы можете видеть на скриншоте, есть возможность выбора браузера.
|
|||
Данный макрос предназначен для поиска адресов электронной почты на листе Excel, с последующим выводом найденных адресов на отдельный лист.В прикреплённом файле, на первом листе ("исходные данные"), ячейки заполнены неструктурированной информацией (смесь фамилий, адресов почты, прочей ненужной информации) Макрос вычленяет из текста ячеек адреса электронной почты, и выводит все найденные адреса email в таблицу на втором листе ("результат")Конечно, не помешало бы ещё проверить все найденные адреса почты на корректность (на соответствие стандартам RFC 5322 и RFC 5321), Для поиска адресов email используются регулярные выражения (RegExp)
|
|||
Надстройка для облегчения ввода значений в ячейку ExcelАвтор: nerv Вам часто приходится заниматься заполнением электронных таблиц, долго и муторно выбирать варианты из выпадающих списков? А, может, иметь дело с одними теми же, но не структурированными данными? Раз так, то данная надстройка призвана облегчить Вам жизнь: сократить время, потраченное на нудную, однообразную работу, а вместе с тем повысить ее качество и эффективность. Как это работает:По нажатию Ctrl+Enter рядом с выделенной ячейкой появляется список, который позволяет не только выбирать, но и производить поиск по интересующим Вас данным. Посмотрим, что он умеет:
|
|||
Зачастую требуется в функциях ввести дополнительный параметр, где пользователь может задать ссылку на ячейку Поскольку фантазия некоторых пользователей ничем не ограничена, да и хочется сделать макрос универсальным, необходимо сделать так, чтобы пользователь мог задать параметр ЯчейкаДляВставки в любом виде - будь то ссылка на ячейку, строку или столбец, или же имя столбца или номер строки. Потому и была написана функция GetCell, которую можно использовать следующим образом: Sub ПримерИспользования_GetCell() ' вставляем значение в первую пустую ячейку столбца A ' (вставка производится ниже всех данных в первом столбце листа) GetCell("a").Value = Now ' то же самое, но с другими вариантами параметра функции (все 4 способа равнозначны) GetCell("a:a").Value = 111 GetCell(Columns(1)).Value = 222 GetCell([a:a]).Value = 333 ' ============ вставка в первую незаполненную ячейку третьей строки ================= GetCell(Destination:=3).Value = 1 ' то же самое, но с другими вариантами параметра функции (все 4 способа равнозначны) GetCell("3").Value = 2 GetCell(Rows(3)).Value = 3 GetCell([3:3]).Value = 4 ' ============ другие варианты использования ================= GetCell().Value = "активная ячейка" ' вставка в заданную ячейку (вызов без параметра) GetCell("NewSheet").Value = "на новый лист в ячейку A1" ' создаётся новый лист GetCell("NewWorkbook").Value = "в новую книгу в ячейку A1" ' создаётся новая книга Excel End Sub
|
|||
Надстройка предназначена для облегчения импорта данных в Excel из текстовых файлов с разделителями (например, из CSV)Пока во вложении - обычный файл Excel с нужными макросами, надстройку выложу позже В надстройке применена функция получения ссылки на заданную пользователем ячейку. Основой для надстройки послужила функция загрузки CSV файла в двумерный массив
|
|||
Надстройка позволяет экспортировать все изображения с листа Excel в графические файлы.Доступен выбор типа создаваемых файлов (поддерживаются форматы JPG, GIF и PNG) Кроме того, можно указать имя папки, в которую будут помещены созданные файлы В имени папки можно указать кодовое слово $filename - оно будет заменено на название текущего (обрабатываемого) файла Excel.
|
|||
Данная функция формирует (создаёт) новую книгу Excel с одним листом (на основании шаблона - листа sh_template), после чего сохраняет новый файл по пути NewFilename$ Если путь не указан, сохранения нового файла не происходит. Function NewWorksheet(ByRef sh_template As Worksheet, Optional ByVal NewFilename$) As Worksheet Application.ScreenUpdating = False: On Error Resume Next: Err.Clear shtv = sh_template.Visible: sh_template.Visible = xlSheetVisible
|
|||
Функции для перевода пикселей в твипы, и обратно Function TwipsPerPixel(Optional ByVal Dimension As Long = LOGPIXELSY) As Long Const TwipsPerInch As Long = 1440: Dim DesktopDC As Long DesktopDC = GetDC(HWND_DESKTOP) TwipsPerPixel = TwipsPerInch / GetDeviceCaps(DesktopDC, Dimension) Call ReleaseDC(HWND_DESKTOP, DesktopDC) End Function Public Function TwipToPixel(ByVal Twips As Long) As Long 'перевод твипов в пиксели TwipToPixel = Twips / TwipsPerPixel() End Function Public Function PixelToTwip(ByVal Pixels As Long) As Long 'перевод пикселей в твипы
|
|||
Function PasteOLEobject(ByVal filename$, ByRef TopLeftCell As Range, _ Optional ByVal Width%, Optional ByVal Height%) As ShapeRange ' вставляет на лист объект OLE (из файла filename$) ' и размещает его в нужном месте, совмещая левый верхний угол с ячейкой TopLeftCell ' если указаны размеры Width% или Height% - они задаются вствляемому объекту On Error Resume Next: Err.Clear Set PasteOLEobject = TopLeftCell.Worksheet.OLEObjects.Add(, filename$).ShapeRange If Err Then MsgBox "Вставка объекта невозможна!", vbCritical: End
|
|||
