Макросы VBA Excel — Страница 8

Извлечение уникальных значений из диапазона ячеек или массива

Функция UniqueValuesFromArray позволяет найти в указанном столбце двумерного массива все уникальные значения, и получить новый массив, содержащий все найденные уникальные значения.
Это может пригодиться, если надо, к примеру, заполнить ComboBox на форме возможными вариантами значений из базы данных:

Private Sub UserForm_Initialize()
    On Error Resume Next: arr = PriceRange.Value
    If Err Then MsgBox "Нет строк для обработки!", vbCritical, "Ошибка": End
 
    ' заполняем комбобокс уникальными значениями из 6-го столбца таблицы
    Me.ComboBox_Source.List = UniqueValuesFromArray(arr, 6)
End Sub

Макрос для выделения дубликатов разными цветами

Выделение разными цветами заливки повторяющихся значений (дубликатов)

Как известно, в последних версиях Excel легко выделить дубликаты цветом, - для этого есть специальная опция в «условном форматировании».
Достаточно выделить диапазон, задать цвет заливки, - и все повторяющиеся (или, наоборот, уникальные) значения будут выделены.

Но иногда требуется, чтобы различные повторяющиеся значения были выделены РАЗНЫМИ ЦВЕТАМИ.
В этом случае, без макросов не обойтись.

Ниже приведён макрос, который как раз и решает эту задачу
(достаточно выделить диапазон ячеек, запустить макрос, - и повторяющиеся непустые ячейки получат одинаковый цвет заливки)

Как скрыть панели инструментов Excel 2003 и ленту Excel 2007 при помощи макроса на VBA

Чтобы убрать с экрана все лишние элементы интерфейса Excel, можно выспользоваться таким кодом:

Поиск цен на Яндекс.Маркете

Результат поиска цен на ноутбуки на Яндекс.Маркете по PartNumber

Программа (3 модуля класса + примеры их использования) предназначена для поиска товаров в Яндекс.Маркете, с последующей загрузкой результатов поиска.

Исходными данными является название (или модель, PartNumber, и т.п.) товара.

На выходе код выдаёт информацию о результатах поиска - 10 (или более) позиций искомого товара,
где для каждой позиции указаны следующие характеристики:

цена (в рублях)
наименование продавца (название организации)
название товара у этого продавца
ссылка на страницу с описанием товара (цена, наличие, условия поставки, описание)

В настройках можно задавать регион для поиска (код региона, или название города \ области \ страны \ континента)

Возвращаемые позиции отсортированы по цене - в порядке её возрастания
(сначала идут самые дешевые товары)

Смотрите также расширенную версию программы поиска цен на Яндекс.Маркете,
с возможностью загрузки цен как по названиям товаров, так и по ссылкам на Яндекс.маркет

Во время запроса данных с сайта Яндекса отображается прогресс-бар.

Во вложении (пароль на проект VBA - 1 (единица)) - пример запроса цен на ноутбуки (исходными данными являются их парт-номера)

Макрос создания копии файла Excel в виде архива ZIP

Макрос для архивации текущей (или активной) книги Excel средствами Windows

(без использования сторонних программ-архиваторов)

Во вложении - файл, при запуске которого автоматически срабатывает такой макрос
При открытии этого файла, если включены макросы, в папке My Program Backups будет сохранена копия книги в формате ZIP (архив)
Папка, если таковая не существует, будет автоматически создана макросом.

Sub CreateBackup()
    ' Макрос создания резервной копии текущего файла
    ' Чтобы макрос обрабатывал активную книгу - замените в коде
    ' все ThisWorkbook на ActiveWorkbook
    ' Архивация файла осуществляется средствами Windows
    
    Const PROJECT_NAME = "My Program" ' название вашей программы (любой текст)
    On Error Resume Next: ThisWorkbook.Save ' сохраняем книгу Excel
    
    ' формируем путь к папке, куда будет помощена копия файла (в виде архива)
    BackupsPath = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, PROJECT_NAME & " Backups\")
    MkDir BackupsPath ' создаём папку, если таковой ещё нет
    
    ext$ = Split(ThisWorkbook.Name, ".")(UBound(Split(ThisWorkbook.Name, "."))) ' расширение файла
    ' формируем путь для копии файла Excel
    FileNameXls = BackupsPath & PROJECT_NAME & "_BACKUP_" & Format(Now, "DD-MM-YYYY__HH-NN-SS") & "." & ext$
    ' формируем путь для создаваемого архива ZIP
    FileNameZip = BackupsPath & PROJECT_NAME & "_BACKUP_" & Format(Now, "DD-MM-YYYY__HH-NN-SS") & ".zip"
 
    ThisWorkbook.SaveCopyAs FileNameXls ' создаём копию книги
    ZIPresult = Zip_File(FileNameXls, FileNameZip, True) ' упаковываем копию книги в архив ZIP
    
    Debug.Print "Результат архивации: " & IIf(ZIPresult, "выполнена успешно", "ошибка")
    Debug.Print "Создан архив: " & Dir(FileNameZip)
End Sub