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

Функция НОД (наибольший общий делитель) на VBA

Ниже представлен аналог встроенной в Excel 2007 функции НОД (наибольший общий делитель), реализованный средствами VBA в Excel

В прикреплённом файле обратите внимание на формулы в синих и зелёных ячейках - как видите, результаты работы функций (встроенной, и пользовательской) полностью совпадают.

Использовать VBA-аналог функции НОД можно по-разному - как задавая в качестве параметра непрерывный диапазон ячеек, так и перечисляя значения (или ссылки на ячейки) через точку с запятой:

=NOD(A3:B4;B5:C6;B8)
=NOD(A4;B4;72)
=NOD(8;12;2;;6)
=NOD(A6:B7;B9:C10)
=NOD(A8:D8)
=NOD(A9;B11:C13)
=NOD(A9:B10;B11:C12;B14)
=NOD(B6;A6;B10;D10)

Внимание! Функция НОД появилась только в Excel 2007 - поэтому при открытии примера в Excel 2003 (и более ранних версиях) будет работать только пользовательская функция, а встроенная выдаст ошибку #ИМЯ!

Чтение значений из реестра Windows на VBA

Чтение и запись в реестр Windows в произвольную ветку можно произвести при помощи функций объекта WScript.Shell:

RegRead и RegWrite

Первая функция возвращает значение, считанное из реестра, вторая - записывает заданное значение в реестр.

При попытке считать несуществующий параметр возникает ошибка,
обойти которую нам поможет директива On Error Resume Next

Пара функций для примера:

(получаем настройки программы из реестра Windows)

Выборка случайных строк из двумерного массива

Массивы

Функция RandomRowsFromArray предназначена для выборки из двумерного массива случайных строк.

К примеру, исходный массив (таблица) имеет размер 1000*20 (1000 строк, и 20 столбцов)
Нам требуется выбрать из этой таблицы, случайным образом, 50 строк
(получив, таким образом, таблицу размерами 50*20)
Кроме того, необходимо, чтобы при каждом новом запуске макроса,
в выборку попадали новые строки.

В прикреплённом к статье файле вы найдете пример такого макроса:

Sub ПримерИспользования_RandomRowsFromArray()
    ' считываем массив с листа
    arr = [a1:e20].Value
    ' считываем количество строк в выборке
    Количество = Val([NewCount])
 
    ' выбираем строки из массива случайным образом (получаем новый массив newarr)
    newarr = RandomRowsFromArray(arr, Количество)
 
    ' заносим результат на лист (справа от исходных данных)
    Range("g1").Resize(UBound(newarr, 1), UBound(newarr, 2)).Value = newarr
End Sub

Преобразование текстовой строки в двумерный массив

Function Text2Array(ByVal txt$, Optional ByVal ColumnsSeparator$ = " ", _
                    Optional ByVal RowsSeparator$ = vbNewLine) As Variant
    ' получает в качестве параметров текстовую строку TXT,
    ' и разделители строк и столбцов для разбиваемой строки
    ' Возвращает двумерный массив - результат разбиения строки
    txt = Trim(txt): On Error Resume Next: Err.Clear
    If txt Like "*" & RowsSeparator$ Then txt = Left(txt, Len(txt) - Len(RowsSeparator$))
 
    tmpArr1 = Split(txt, RowsSeparator$): RowsCount = UBound(tmpArr1) + 1

Ведение логов действий программы (модуль класса)

Для использования подобного кода записи логов необходимо скопировать (перетащив мышкой) модуль класса LogRecorder из прикреплённого файла в ваш файл.

Sub ПримерИспользованияКласса_LogRecorder()
    ' создаём новый экземпляр лог-рекордера
    Dim LR As LogRecorder: Set LR = New LogRecorder
    ' задаём имя файла для лога (указываем полный путь)
    LR.LogFileFullName = ThisWorkbook.Path & "\common.log"
    LR.OpenLog    ' открываем лог (очистка файла + запись стартовой строки)

    For i = 1 To 10
        ' здесь ваш код ...
        ' заносим запись в лог
        LR.AddRecord "Событие " & i, "Информация " & i, 1
        If i Mod 3 = 0 Then ' i делится на 3 без остатка
            ' добавляем запись, до и после неё вставляем строку-разделитель
            LR.AddRecord "Значение " & i & " делится на 3 без остатка", _
                         "дополнительная проверка", 2, LOG_SEPARATOR_BEFORE_AND_AFTER
        End If
    Next i
    LR.AddRecord "Цикл завершен", "Проверено 10 чисел", 1, LOG_SEPARATOR_AFTER
 
    LR.CloseLog  ' закрываем лог (очистка буфера + запись конечной строки)
    ' LR.Show ' запуск текстового файла с логом (для просмотра
End Sub

Можно при добавлении записей в лог указать уровень записей - чтобы выделять отдельные записи отступом слева, как на этом скриншоте: http://ExcelVBA.ru/pictures/20110829-cd9-96kb.jpg

Кроме того, можно задать максимальное значение буфера лога (запись непосредственно в файла происходит не при каждом выполнении команды AddRecord, а только при превышении размера буфера, принудительном сохранении лога опцией ForceSavingLog=TRUE, а также при сохранении лога командой SaveLog, и при закрытии лога методом CloseLog )
Размер буфера можно изменить, задав значение свойства maxLogSizeBeforeSave (количество символов, при котором лог-файл будет сохранён принудительно, по умолчанию = 5000)

Результатом работы этого кода будет создание файла с именем common.log в той же папке, где расположен файл Excel с макросом:

Пропорциональное изменение размеров изображения в зависимости от значения в ячейках

Этот простейший макрос позволяет пропорционально изменять размеры изображения (высоту и ширину) в зависимости от значений ячеек B3 и B4.

Получение текущей даты и времени с сервера в интернете

Функция GetRealTime выполняет HTTP-запрос к заданному серверу,
и из заголовка Date ответа сервера берёт текущее время и дату.

Разбиение двумерного массива на несколько массивов, группируя строки по заданному столбцу

Функция принимает в качестве параметра arr двумерный массив, и разбивает его на несколько массивов, группируя строки по значению столбца SplitColumn&

Сколько есть уникальных значений в столбце SplitColumn&, удовлетворяющих маске Mask$, - столько двумерных массивов будет возвращено функцией в виде коллекции

Например, если есть исходный массив размерами 100*5, в котором во втором столбце есть 3 разных значения,
то функция SplitArray(arr, 3) вернёт коллекцию из 3 элементов - массивов размерами 25*5, 7*5, 68*5

Чтобы откинуть строки с пустыми значениями, можно применить маску "?*"
Можно взять только строки со сзначениями, начинающимися с цифры, содержащими текст "txt", - в этом случае, в параметр Mask$ надо передать строку "#*txt*"

Пример использования функции разделения массивов на несколько:

Конвертер BMP в Excel (попиксельный перенос изображения на лист)

Перенос изображения на лист Excel (чтение bitmap в массив)

Данный макрос читает информацию о цветах пикселей в битмапе (изображение BMP), формирует двумерный массив, содержащий информацию о цвете каждого пикселя, после чего переносит массив цветов на лист (в цикле закрашивая ячейки).

Поддерживаются только 24-битные изображения BMP без сжатия.
Некоторые изображения обрабатываются некорректно - для них есть другой вариант кода (в прикреплённом варианте файла отсутствует)

Для чтения информации из bitmap используется функция API-функция GetBitmapBits

Преобразование результатов работы функции GetBitmapBits в двумерный массив производится следующим кодом:

Сохранение значений в скрытых именах книги Excel

Данные функции могут быть полезны, если вы хотите спрятать некоторые значения в книге Excel

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

НАДСТРОЙКИ ДЛЯ EXCEL