У меня вылезла проблема, что из-за ежедневных рассылок изрядно заполнился почтовый ящик на mail.ru. По объёму меня не угнетало, но надоело, что там лежит 1500+ писем, которые я никогда читать не буду. Удалять их через WEB интерфейс то ещё удовольствие. Решил написать программу, которая сделает это за меня. С запросом к GeekBot написать программу в PowerShell у меня не срослось. Визуально код нормальный, но в Windows-10 программа не заработала от слова вообще. Такое ощущение, что не хватает библиотек для работы с почтой по протоколу IMAP. Запросил программу на Python.

Вот текст запроса: напиши программу на python для удаления писем из почтового ящика на сервере mail.ru. в теме письма должно быть "3DNews" и письма должны быть получены ранее 01/08/2025

Прилетел код, но не совсем рабочий. Пришлось поправить:

1. Спотыкался при пустой теме письма;

2. Не совпадали тип указанной даты с типом даты в письме;

3. Добавил вывод на экран списка папок;

4. Добавил вывод на экран протокола работы.

В итоге проковырялся 2 часа. Научился читать, править и использовать python, удалил 1500+ писем.

Код программы:

... Читать дальше »

Поиск через VBA на примере проверки лотерейных билетов "Мечталлион". В ячейке F1 вводим цифру, ищет на листе и выделяет цветом, если нашлась.

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

Функция проверки изменений в ячейке F1:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Intersect(Target, Range("F1")) Is Nothing Then
        If Not IsEmpty(Range("F1")) Then
            lLastRow = Cells(Rows.Count, "A").End(xlUp).Row 'определяем последнюю строку по наличию данных в столбце A
            FindValue ("A1:D" + Trim(Str(lLastRow))) 'передаём диапазон для поиска в функцию FindValue
        End If
'        Application.Run "Find.xlsm!FunctionName" 'пример вызова функции из другого файла
    End If
End Sub

Функция поиска и выделения цветом:

Sub FindValue(r) 'r принимает значение области поиска в виде "A1:D9", вычисляется и передаётся из функции Worksheet_Change с Лист1
    Dim c As Range
    Dim firstAddress As String

    With Worksheets(1).Range(r)
        Set c = .Find(Range("F1").Value, LookIn:=xlValues, LookAt:=xlWhole) '"F1" - ищем данные из этой ячейки. LookAt:=xlWhole искать значение целиком, если убрать будет искать по вхождению.
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                With c.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 5296274
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And firstAddress <> c.Address 'в примере от MS не было проверки firstAddress, что приводило к зацикливанию
        End If
    End With
End Sub

Файл XLSM скачиваем тут...

Написана Александром Калининым и мною ещё году в 1993, адаптирована под Excel году в 1996.

Устанавливать можно прямо в Excel-евский файл. Включаем "Режим разработчика", в "Разработчике" переходим в "Редактор Visual Basic". Правую кнопку мыши на "Microsoft Excel Objects", "Import File..."

после этого функцию можно вызвать:

=Прописью(ФИКСИРОВАННЫЙ(Число;2;ИСТИНА))

Где вместо Число подставляем число или адрес ячейки.

Например:

=Прописью(ФИКСИРОВАННЫЙ(F15;2;ИСТИНА))

Скачиваем функцию тут...