Как написать макрос в Excel — создание, запись и редактирование VBA макросов в Excel

VBA считается стандартным языком написания сценариев для приложений Microsoft, и в настоящее время он входит в состав всех приложений Office и даже приложений других компаний. Следовательно, овладев VBA для Excel, вы сможете сразу перейти к созданию макросов для других программных продуктов Microsoft. Более того, вы сможете создавать полноценные программные продукты, одновременно использующие функции самых разных приложений.

Как включить макросы в Excel

По умолчанию, вкладка, отвечающая за управление и навигацию  макросов в Excel, скрыта. Чтобы активировать данную опцию перейдите по вкладке Файл в группу Параметры. В появившемся диалоговом окне Параметры Excel, перейдите по вкладке Настройка ленты, в правом поле со списком ставим маркер напротив вкладки Разработчик. Данные действия актуальны для версий Excel 2010 и старше.

отображение вкладки разработчик

На ленте появиться новая вкладка Разработчик с элементами управления автоматизации Excel.

вкладка разработчик excel

Написание макросов в Excel

Во вкладке Разработчик в группе Код, нажмите кнопку Запись макроса. Появиться диалоговое окно Запись макроса, которая запрашивает некоторую информацию о будущем записываемом коде. Если вы впервые создаете макрос, можете просто нажать кнопку ОК. С данного момента Excel будет фиксировать каждое действие пользователя в модуле VBA, будь то ввод данных, форматирование или создание диаграмм. Чтобы остановить запись макроса, нажмите кнопку Остановить запись, которая находится в той же группе Код.

отключить макросы в excel

Вы также можете воспользоваться альтернативным вариантом записи макросов, воспользовавшись кнопкой Запись макроса, которая находится в левом нижнем углу рабочей книги Excel (правее статуса Готово).

Теперь вы можете посмотреть список всех созданных макросов, нажав на кнопку Макрос, находящуюся в группе Код. В появившемся диалоговом окне вы можете дать более описательные имена своим кодам или задать сочетания клавиш, которые бы запускали тот или иной макрос. Альтернативным вариантом запуска данного окна является нажатие клавиш Alt + F8.

список макросов

Редактирование макросов

Поздравляю! Вы написали свой первый макрос. Логичным будет проверить теперь, какой же код сгенерировал нам Excel. Сгенерированный код написан на языке VBA (Visual Basic for Applications). Чтобы увидеть его, нужно открыть Редактор VB (VBE), который запускается нажатием клавиш Alt + F11 или кнопкой Visual Basic на вкладке Разработчик.

Чтобы избежать путаницы в редакторе вы можете работать только с одной вкладкой рабочей книги, листа или модуля. Так выглядит редактор в реалии.

редактор макросов

Предлагаю на данном этапе подробнее изучить различные окна и меню редактора VBA. В дальнейшем это поможет вам сэкономить кучу времени.

Для просмотра кода, щелкните по ветке Modules в окне проектов и дважды щелкните по появившейся ветке Module1. Редактор откроет окно с кодом, как изображено на картинке.

код в редакторе макросов

Здесь можно редактировать сгенерированный код, который был записан при работе в Excel. К примеру, вам требуется заполнить определенный столбец значениями от 1 до 10. У вас уже есть первые три шага, которые вводят значения 1, 2 и 3 в первые три ячейки столбца А. Нам необходимо дописать оставшиеся семь шагов.

Если вы посмотрите на приведенный выше код, вы увидите, что макрос определенным образом структурирован. Сначала приложение перемещает курсор на ячейку с помощью команды Range("A1").Select, затем редактирует его содержимое с помощью ActiveCell.FormulaR1C1 = "1". Таким образом, для оставшихся шагов мы можем повторить эти действия, меняя адрес ячейки и значение, которое вы хотите записать в эту ячейку. Например, чтобы задать ячейке A4 значение 4, вы должны написать:

1
2
Range("A4").Select
ActiveCell.FormulaR1C1 = "4"

И повторить аналогичные шаги для оставшихся значений.

После того, как вы закончите редактирование, сохраните книгу. Запустить макрос вы сможете нажатием кнопки F5, либо, вернувшись в рабочую книгу Excel, перейти по вкладке Разработчик в группу Код -> Макросы и выбрать из списка, интересующий вас макрос.

Уделите несколько минут внимательному изучению кода, который сгенерировал Excel. Если вы новичок, вклад нескольких минут в изучение кода дадут потрясающий результат в знакомстве с объектами VBA в дальнейшем. Обратите внимание, что рассмотренный нами пример всего лишь иллюстрация. Есть более быстрые и эффективные способы достижения аналогичных результатов, о которых мы поговорим далее.

Увеличение скорости выполнения макросов Excel

Пока все хорошо. Давайте разберем пару хитростей, которые помогут ускорить выполнение макроса. Рассмотрим в качестве примера фрагмент кода, приведенный выше. Современные компьютеры отработают рассматриваемый код так быстро, что вы даже не заметите этого. Но что если вам необходимо выполнить операцию 50000 раз. Это займет какое-то время. Если макрос, написанный вами, исчисляется сотнями строк, ускорить выполнение кода можно путем обрезки части процессов, который не используется во время исполнения макроса.

Использование команды Application.ScreenUpdating

Первый фокус заключается в том, чтобы отказаться от обновления экрана в момент выполнения макроса. Это позволит Excel сохранить вычислительные мощности компьютера и обновить экран со свежими значениями, только после того, как весь код будет выполнен. Для этого необходимо добавить команду отключения обновления экрана в начале макроса и команду включения обновления экрана в конце макроса.

1
2
3
4
5
6
7
8
9
10
Sub Макрос1()
Application.ScreenUpdating = False
Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A3").Select
ActiveCell.FormulaR1C1 = "3"
Application.ScreenUpdating = True
End Sub

Команда Application.ScreenUpdating говорит Excel, чтобы он прекратил выводить пересчитанные данные на экран, а выдал готовые значения в конце выполнения кода.

Использование команды Application. Calculation

Вторая хитрость заключается в отключении автоматических вычислений. Давайте я поясню. Каждый раз, когда пользователь или процесс обновляет ячейку, Excel пытается пересчитать все зависимые от нее ячейки. Так скажем, если ячейка, которую пытается обновить макрос, влияет на 10000 остальных ячеек, Excel будет пытаться пересчитать их все до того, как закончится выполнение кода. Соответственно, если существует целый ряд влияющих ячеек, пересчет может значительно замедлить выполнение кода. Чтобы этого не происходило, вы можете установить команду Application. Calculation в начале кода, которая переключит пересчет формул в ручной режим, а затем вернуть автоматическое вычисление в конце макроса.

1
2
3
4
5
6
7
8
9
10
11
12
Sub Макрос1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A3").Select
ActiveCell.FormulaR1C1 = "3"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Будьте внимательны, не забудьте переключить данную опцию снова в автоматический режим в конце макроса. В противном случае, вам необходимо будет это сделать в самом Excel, перейдя по вкладке Формулы в группу Вычисление и выбрать Параметры вычислений –> Автоматический.

Избежание выбора ячеек и диапазонов

В режиме автоматической записи макросов, вы можете заметить, что Excel очень часто использует команду выбора ячеек, например, Range(«A1»).Select. В нашем примере, мы использовали данную команду несколько раз, чтобы выбрать ячейку и изменить ее значение. Вы можете избежать этого просто указав адрес ячейки и задав ей необходимое значение (Макрос записал движение курсора от одной ячейки к другой, следовательно, вставил эти шаги. Однако они не являются необходимыми). Так что, более эффективный код будет выглядеть следующим образом.

1
2
3
4
5
6
7
8
9
10
11
Sub Макрос1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("A1").Value = 1
Range("A2").Value = 2
Range("A3").Value = 3
Range("A4").Value = 4
Range("A5").Value = 5
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

В данном случае мы просто сослались на ячейку и задали ей необходимое значение, не выбирая его вообще. Это способ быстрее, чем предыдущий.

Примеры макросов Excel

Ниже приведены несколько примеров кодов VBA, которые помогут автоматизировать наиболее часто повторяющиеся задачи:

Макрос вставки строки

1
2
3
Sub Макрос1()
Rows(2).EntireRow.Insert 'Вставляет строку перед второй строкой
End Sub

Макрос вставки столбца

1
2
3
Sub Макрос1()
Columns(3).EntireColumn.Insert 'Вставляет столбец левее 3-го столбца
End Sub

Макрос форматирования

1
2
3
4
5
6
Sub Макрос1()
'Делает формат ячейки D2 жирным, подчеркнутым и курсив
Cells(2, 4).Font.Bold = True
Cells(2, 4).Font.Underline = xlUnderlineStyleSingle
Cells(2, 4).Font.Italic = True
End Sub

Макрос обхода диапазона ячеек

1
2
3
4
5
6
Sub Макрос1()
For Each cel In Range(Cells(1, 1), Cells(10, 5))
counter = counter + 1
cel.Value = counter
Next cel
End Sub

Возможность писать макросы является одним из наиболее продуктивных способов решения повседневных задач. Они позволяют автоматизировать рутинные операции и выполнять их с гораздо большей скоростью.


52 комментариев

  1. а можно более подробно рассказать о VBA начиная с основ: порядок написания, какие операторы что выполняют или порекомендовать какую-нибудь литературу. Заранее спасибо.

    • Из литературы могу порекомендовать дедушку Джона Уокенбаха, очень грамотное изложение, сам когда-то начинал с него. По поводу операторов и циклов, планирую начать серию статей по VBA с описанием всех ключевых моментов

      • Уважаемый Ренат. Начал изучать vba по записям Уокенбаха. Но столкнулся с с задачей которую решить мои начальные знания в программировании не могут… пока). Если есть возможность прошу вашей помощи в её решении. Итак задача:
        есть Список из 10 магазинов, у каждого магазина есть ряд показателей пока их 5, эти показатели фиксируются каждый месяц в общей таблице, потом на основании неё формируются отчеты. Сложность заключается в процессе забивания, т.к. таблица становится очень большой 60 столбцов. для облегчения внесения данных я бы хотел что бы «ненужные» столбцы скрывались.
        Так как это можно сделать только с помощью макроса, не могли бы вы показать каким он должен быть при условии что выбор месяца\квартала\полугодия происходит с помощью «переключателя» из разработчика. заранее очень благодарен.

        • Сергей, если я правильно понял, то вы пытаетесь вызвать событие Worksheet_Change с помощью элемента управления Поле со списком, которое позволяет изменять значения ячейки в зависимости от выбранного значения. К сожалению, Excel не воспринимает изменения сделанные элементом как события и поэтому макрос не вызывается. Я рекомендую использовать элемент ActiveX ComboBox, которое выглядит аналогичным образом, но действует не как элемент листа рабочей книги, а как элемент формы VBA, у которого в свою очередь есть ряд своих событий, например ComboBox.Change. В файле пример использования данного приема — ComboBox Event

          • Использовал ComboBox. а какой должен быть макрос при этом?

          • В файле примера я указал, какой макрос можно использовать. Его можно увидеть либо в редакторе VBA, либо двойным щелчком по ComboBox в режиме конструктора

          • Слона я и не заметил. Огромное спасибо!

  2. у вас очень хороший и главное полезный блог. стал регулярным вашим читателем :)
    вы обязательно наберете свою аудиторию — пишите почаще.

  3. Здравствуйте
    Хотел спросить вопросик немного не по теме: что вы думаете по поводу подключения таблиц excel к access для дальнейшей обработки. Дело в том что я не очень уверен в стабильности этого соединения, к тому же не очень удобно переносить проект из одной сетевой папки в другую. Поискав в нете я нашел что можно создавать при помощи VBA таблицы в самом access копируя их с заданных листов excel, но лично для моих знаний VBA это уже сложновато. Хотелось бы услышать мнение специалиста…
    Заранее спасибо.

    • К сожалению, ни разу не сталкивался с подобной необходимостью и помочь чем-нибудь дельным не могу. Был опыт экспорта данных с помощью VBA из Excel в SQL базу данных, но бесконечные ошибки несовместимости данных привели к тому, что я отказался от этого подхода

  4. Здравствуйте.
    Потребовалось мне в Excel 2007 убрать первый пробел из всех ячеек столбца. Решил сделать макрос. Очень простой: F2, Home, Del, Enter. Записал. Начал выполнять, а он мне во все ячейки вставляет текст из этой первой ячейки. Открыл макрос и увидел следующий код:
    ActiveCell.FormulaR1C1 = "Асфальтобетонная смесь"
    ActiveCell.Offset(1, 0).Range("A1").Select
    Ну, и зачем мне такие макросы? Не подскажете как в Excel 2007 можно записать последовательность нажатия клавиш на клавиатуре и потом её воспроизвести?

    • Добрый день, Сергей
      К сожалению, функция записи макросов не отсеживает нажания клавиш, как я уже писал, данный инструмент весьма ограничен. За симуляцию нажатия клавиш отвечает команда Sendkeys. Вот хорошая статья на эту тему.
      А вообще, чтобы избавиться от ненужных пробелов, существует отличная функция Excel — СЖПРОБЕЛЫ.

      • Спасибо большое за ответ, Ренат.
        Но благодаря этому своему небольшому опыту я понял, что для обычного пользователя функция «Запись макроса» потеряла смысл. Нужно знать VBA чтобы соорудить нормальный работоспособный макрос. А что получится при записи, наверное, только разработчики могут сказать.

        • Сергей, очень жаль, что первые опыты с макросами получились не столь удачными. Все таки — это машина, и ей не всегда понятно, какое действие хочет записать человек. Помню, как после первых записанных макросов, мне тоже приходили подобные мысли. В итоге было принято решение купить книгу по макросам) В своей работе функцию записи макросов я использую больше для понимания синтаксиса той или иной команды. Экспериментируйте, сейчас многие готовые вещи можно найти в сети, и со временем понимание придет.

  5. Ренат, Здравствуйте. Сделал небольшую таблицу, у которой есть поле со списком (элемент управления формы) и при выборе любого элемента в этом списке высвечивается сообщение «не удалось выполнить макрос "год.xls!раскрсписок747_Изменение". возможно, этот макрос отсутствует в текущей книге либо все макросы отключены».
    макросы включены. в списке макросов такого нет. И не могу избавиться от этого назойливого сообщения. не могли бы подсказать в чем тут дело и как это исправить. заранее спасибо.

    • Добрый день, Сергей
      Видимо, когда-то к этому элементу был прикреплен макрос, а потом его удалили, но при этом связь с элементом осталась.
      Я не нашел способ, как можно удалить эту связь на уровне интерфейса Excel. Получилось только с помощью макроса. Идея заключается в следующем, необходимо перепривязать макрос к элементу, но в параметрах не указывать имя макроса. Тогда получится, что мы перепривяжем макрос с отсутствующим именем, а старая связь удалится.
      Команда в VBA выглядит следующим образом:
      ActiveSheet.Shapes("имя_раскрывающегося_списка").OnAction = ""

  6. Здравствуйте! Подскажите мне пожалуйста как вывести данные в excel из sql с помощью макроса. Подключение к базе я сделала и какие поля нужны тоже выбрала. Вобщем запрос написала. А как теперь сделать чтобы эти данные появились в excel я не пойму. Какой код нужен для вывода на лист. Спасибо

  7. Здравствуйте.
    Есть лист с данными, часть из которых постоянная, а часть каждый раз вносится пользователем. Необходимо, чтобы все нужные данные собирались в текст с сохранением форматирования (цвет и шрифт текста). Первая задача решается элементарной формулой «сцепить» с условием «если». Вторая часть задачи стандартными функциями Exel невыполнима. Подскажите,пожалуйста, какой может быть записан макрос, чтобы текст из ячеек все-таки сохранял форматирование при сцеплении???
    Сама лично никогда не работала с языком VBA.

    • Ульяна, если я правильно понял, вам необходимо создать пользовательскую функцию, которая бы по аналогией с функцией СЦЕПИТЬ, еще копировала формат. К сожалению, функции написанные на VBA не позволяют изменять форматирование. Выходом из ситуации будет использование копирования форматов, которую можно найти правым щелчком мыши -> специальная вставка -> Вставить форматы.

  8. Здравствуйте! Есть файл, несколько листов, первый подтягивает данные из интернета, на втором выполняется расчет. Беда в том, что при закрытие и новом открытие файла, данные на первом листе обновляются и на втором листе сбиваются ссылки на первый лист. Пробовал делать новый лист с изъятием нужных нужных ячеек, а расчет выполнять уже на него. Не получилось. Тогда я записал макрос, который при выполнении записывает ссылки. Так вот он корректно работает до первого закрытия. Потом он записывает ссылки но так же не корректно. Подскажите что я не так делаю.

  9. Добрый день! В рамках подготовки ФЭМ необходимо провести анализ чувствительности фин индикаторов в том числе к параметрам, которые являются рядом переменных (прогноз цен на нефть), каждая из которых задается не числом, а формулой, причем использовать несколько сценариев. Иных вариантов как макрос, я не вижу, но написать его пока мне не по силам. Поскольку задача стандартная, не подскажете, может быть,где-н есть примеры/ образцы? Заранее большое спасибо!

    • Елена, в вашем примере речь, скорее всего, идет не о сортировке, а о группировке. Чтобы реализовать данную возможность воспользуйтесь инструментом Группировка, который находится во вкладке Данные

  10. Ренат, здравствуйте! Помогите, пожалуйста, в реализации следующего:
    лист 1 содержит таблицу с данными основными. лист2 содержит таблицу, в которую должны подтягиваться в соответствующие ячейки строки данные из таблицы листа1 при заполнении ячейки «номер помещени».
    То есть, например. в листе 2 в таблице забиваю в ячейку №помещения текстом определенный номер и автоматом заполняются данные площади и ставки аренды, соответствующие данному номеру помещения.

    Заранее спасибо!

    Файл:  .xlsx

  11. есть задача:
    1. файл ексель должен самостоятельно выбирать пол (ая, ый)
    — должен при нажатии на кнопку — сохранять всё на рабочем столе в пдф
    при сохранении, имя файла должно быть: номер письма + ячека текст
    — должен сохранять копию на рабочем столе
    !!! Это всё работало на 7, пока я виндоус 8.1 не установил

    2. Аутлук:
    автоматическое копирование контактов, календарей, задач, писем из уч. записи MAPI в Exchange

    Ответ на почту. Цена вопроса

  12. Ренат, доброго времени суток!)
    Мне необходимо найти или разработать приложение для работы с БД предприятия. Какой-нибудь графический интерфейс для вывода всей соответствующей информации детали и последующего изменения серийного номера этой детали или документа к ней.

    Как я могу это сделать? Какой софт или плагины посоветуете? Спасибо

  13. Доброго времени суток! Можно ли в exel сделать такую фишку: в ячейках А1-А10 стоят значения 10; в ячейке А-11 сумма значений А1-А10 (100); нужно чтобы в ячейке А-11 стояла сумма 150 при этом чтобы в ячейках А1-А10 стояли значения 10. Спасибо. Очень нужно.

  14. Добрый день, очень нужна помощь. Есть таблица, которая по столбцам каждый день копируется вправо. Очень нужен макрос, который бы копировал таблицу в пустую колонку справа.

    Файл:  1.xlsx

  15. Добрый день, Ренат!

    Возник такой вопрос. Требуется ограничить число символов в ячейках. Но! Так, чтобы в одном столбце было ограничение 10 символов, а в соседнем — 20 символов. Также интересует немного не то, что нашлось в сети. В основном предлагаются коды, которые режут по факту. Т.е. пишешь-пишешь, а потом — бац, и половину обрезало. Нужно, чтобы при попытке напечатать 11ый (или 21ый) символ программа сразу сообщала, что лимит превышен. Я так думаю, чисто теоретически такая система должна конструироваться. Чисто практически же пока не знаю, куда копать.

  16. Здравствуйте.
    Помогите пожалуйста:
    Можно написать макрос. чтобы он скрывал определенные строки (например 2, 4, 7) в листе (Лист2) в том случае если определенная ячейка в другом листе Exel пустая (например D4) в листе (Лист1)

  17. Здравствуйте!
    Подскажите пожалуйста, как настроить Exсel на автоматическое создание копии или сохранение книги при закрытии без запроса на сохранение. При этом, чтоб в названии файла автоматически вставлялась необходимая дата, к примеру:
    01.01.2016г. поработал в книге под названием «Документ», внёс кое-какие изменения на разных листах и при закрытии создавалась копия на рабочем столе с датой завтрашнего дня «Документ 02.01.2016г.» При повторном открытии-закрытии файла «Документ» в этот же день еще одна копия «Документ 02.01.2016г.(2)» — но при этом, чтобы файл «Документ» оставался без изменений, а менялся только когда самостоятельно его перезаписываешь!
    Заранее благодарю!

    • Александр, добрый день. К сожалению, у меня нет возможности писать коды, на подобного рода запросы. Рекомендую поискать в Google, например, такой запрос «сохранить vba excel». Там этой информации тонны.

  18. Спасибо, Ренат!

    Теперь над другой дилеммой голову ломаю.
    Может поможете?
    Необходимо создать кнопку, при нажатии которой производилось сложение двух ячеек.
    Сложность заключается в том, нужно чтобы при повторном нажатии на эту же кнопку ничего не происходило! Короче говоря — можно ли ограничить в нажатии на кнопку? Либо каким кодом руководствоваться, чтоб сумма чисел производилась только один раз?
    Ситуация в том, что:
    имеется таблица «Док1» в которой я создал кнопку, при нажатии на которую — таблица автоматически сохраняется под именем с текущей датой «Док(дата)» в определённую папку и одна из ячеек суммируется к ячейке другого документа «Док2». А при повторном нажатии этой кнопки программа пересохраняет «Док(дата)» и в «Док2» опять прибавляет значение ячейки из «Док1», а мне повторное сложение не нужно!!!
    Спасибо за внимание!

  19. Добрый день,

    Подскажите, пожалуйста, можно ли сделать такое макросом:
    Есть продажи по месяцам. Левый столбец наименования, далее соответствующие месяца. Но есть одно «но». Ввиду некоторых особенностей одна и та же позиция бывает в нескольких вариантах. Например:
    йцукен
    йцукенУ1
    йцукен о
    Естественно, они выпадают как три строки. Можно ли как-либо прописать макрос, чтоб он по первым, допустим, 5 сиволам эти строки объединил в одну, а оставшиеся удалил?

    Заранее спасибо.

  20. Добрый день!Можете рассказать подробнее: как получить код программы, изменяющей цвет текста в ячейках рабочего листа MS Excel.

  21. Добрый день.
    Это сообщение из маркетингового альянса и нам важно Ваше мнение. Появилась новая тенденция, можно отслеживать у конкурентов потенциальных клиентов, особенно это актуально в вашей нише, что думаете по этому поводу? Подробности можно посмотреть вот в этом видео http://bizzersin.ru/video49385

  22. Ренат, здравствуйте

    Хотел спросить у вас.

    У меня такая проблема.
    Есть Таблица в Excel с кучей фильтров, кучей данных где строка — это какой то эксперимент, и в столбцах идут данные из этого эксперимента. И в одном из столбцов картинка для визуализации, привязанная к ячейки

    Я сделал график, где вместо маркеров стоят эти же картинки (чтобы меняя параметры на графике, смотреть, как будут располагаться эти картинки). Но тут возникает проблема, когда я применяю фильтры для данных, картинки перестают соответствовать точке.

    Я попробовал сделать график и вставить туда картинки из ячеек, но не получилось.
    Вы бы не могли подсказать, как можно решить проблему привязки картинок к точке, может, макросы могут помочь с этим.

    С уважением
    Сергей

  23. Здравствуйте, Ренат,

    У меня много наработок в VBA Excel2003 под Windows XP.
    Но судьба заставила перейти на Windows 10 и Excel2007.
    Оказалось, что часть моих программ не работает.
    Причем именно те, где используется Shape. Начал разбираться.
    Раньше (в Excel2003) делал это так: запишу макрос, проанализирую код.
    А в Excel2007 так не получается. Макрос, конечно, записывается, но пустой.
    Пробовал записывать манипуляции с ячейками. Range записывается отлично.
    Как только работаю с графическими объектами — тоскливая пустота :(
    Подскажите, пожалуйста, выход.

    С надеждой и уважением,
    Владимир

  24. Здравствуйте,
    У меня проблема при отображении русских букв в экселе формата (.csv)
    Пробовал ипортировать данные инструментами экселя, но при этом сбиваются колонки и текст «перемешивается».
    нашел скрипт в интернете по перекодировке текста в формат UTF-8.
    Подскажите, как его вставить в книгу эксель. (ALT+F11 нажимать умею, а что дальше, какие данные прописывать в теле кода и как его запускать?)

    за раннее спасибо!

    P.S. Моя конечная цель перекодировать текст в формат UTF-8 в конкретной колонке.

    Пример скрипта:
    Function ChangeFileCharset_UTF8noBOM(ByVal filename$, Optional ByVal SourceCharset$) As Boolean
    ‘ функция перекодировки (смены кодировки) текстового файла
    ‘ В качестве параметров функция получает путь filename$ к текстовому файлу,
    ‘ Функция возвращает TRUE, если перекодировка прошла успешно
    On Error Resume Next: Err.Clear
    DestCharset$ = «utf-8»
    With CreateObject(«ADODB.Stream»)
    .Type = 2
    If Len(SourceCharset$) Then .Charset = SourceCharset$ ‘ указываем исходную кодировку
    .Open
    .LoadFromFile filename$ ‘ загружаем данные из файла
    FileContent$ = .ReadText ‘ считываем текст файла в переменную FileContent$
    .Close
    .Charset = DestCharset$ ‘ назначаем новую кодировку «utf-8»
    .Open
    .WriteText FileContent$

    ‘Write your data into the stream.

    Dim binaryStream As Object
    Set binaryStream = CreateObject(«ADODB.Stream»)
    binaryStream.Type = 1
    binaryStream.Mode = 3
    binaryStream.Open
    ‘Skip BOM bytes
    .Position = 3
    .CopyTo binaryStream
    .Flush
    .Close
    binaryStream.SaveToFile filename$, 2
    binaryStream.Close
    End With
    ChangeFileCharset_UTF8noBOM = Err = 0
    End Function

  25. Здравствуйте.
    Возникла проблема при разработке нового отчета , суть задачи :
    -есть календарь,в котором выбирается дата для внесения данных
    -есть ячейка,которая выводит выбранную в календаре дату
    -есть всплывающее меню со списком действий с зависимой ячейкой выбранного пункта
    -таблица с названиями строк (действия) и столбцов (дата)
    Нужно при нажатии на кнопку внести данные в ячейку,указаную выбраными параметрами.
    Признаю, от VBA далек и только пытаюсь разбираться. Банальное указание в макросе Range.(«=adress….») вызывает ошибку

  26. Public Sub KK()
    Call Periods
    Call Procents
    Call procent_txt
    ‘Call Kvartals
    Call preparation_excel
    Call InWord.InWord
    End Sub
    Public Sub Periods()
    Sheets(1).Range(«C4:G400»).ClearContents
    startday = Range(«B2»).Value
    i = 2
    j = 6
    Do While Sheets(2).Range(«C» + CStr(i)).Value «»
    If startday > Sheets(2).Cells(i, 3).Value And startday < Sheets(2).Cells(i, 4).Value Then
    Sheets(1).Cells(j, 3) = Sheets(2).Cells(i, 3).Value
    Sheets(1).Cells(j, 4) = Sheets(2).Cells(i, 4).Value
    Sheets(1).Cells(j, 5) = Sheets(1).Cells(j, 4) — Sheets(1).Cells(j, 3) + 1
    Sheets(1).Cells(4, 3) = startday
    Sheets(1).Cells(4, 4) = Sheets(2).Cells(i, 4).Value
    Sheets(1).Cells(4, 5) = Sheets(1).Cells(4, 4) — Sheets(1).Cells(4, 3) + 1

    j = j + 1
    End If
    If startday < Sheets(2).Cells(i, 3).Value And startday < Sheets(2).Cells(i, 4).Value Then
    Sheets(1).Cells(j, 3) = Sheets(2).Cells(i, 3).Value
    Sheets(1).Cells(j, 4) = Sheets(2).Cells(i, 4).Value
    Sheets(1).Cells(j, 5) = Sheets(1).Cells(j, 4) — Sheets(1).Cells(j, 3) + 1
    j = j + 1
    End If
    i = i + 1
    Loop
    End Sub
    Public Sub Procents()
    i = 1
    flag = 0
    Do While flag DataProc Or Sheets(1).Cells(j, 4).Value DataProc Or Sheets(1).Cells(j, 4).Value < DataProc
    j = j + 1
    Loop
    symma = CDbl(Replace(Sheets(3).Cells(i, 7).Value, ".", ","))
    Sheets(1).Cells(j, 7).Value = Sheets(1).Cells(j, 7).Value + symma * (-1)
    End If
    If Sheets(3).Cells(i, 1).Value = "" Then
    flag = flag + 1
    Else
    flag = 0
    End If

    i = i + 1
    Loop
    Sheets(1).Cells(4, 6) = Sheets(1).Cells(6, 6) / Sheets(1).Cells(6, 5) * Sheets(1).Cells(4, 5)
    If Sheets(1).Cells(6, 7) «» Then Sheets(1).Cells(4, 7) = Sheets(1).Cells(6, 7) / Sheets(1).Cells(6, 5) * Sheets(1).Cells(4, 5)
    i = 6
    Do While Sheets(1).Cells(i, 3) «»
    i = i + 1
    Loop
    Do While Sheets(1).Cells(i, 6) = «» And Sheets(1).Cells(i, 7) = «»
    Sheets(1).Cells(i, 3) = «»
    Sheets(1).Cells(i, 4) = «»
    Sheets(1).Cells(i, 5) = «»
    i = i — 1
    Loop
    End Sub
    Sub procent_txt()
    Range(«A4:B400»).ClearContents
    i = 4
    day_num = Cells(6, 5)
    ‘If day_num 31 Then day_txt = «дня»
    day_txt = «дн.»
    Range(«A» + CStr(i)) = «Розрахунок нарахованих відсотків, які підлягають сторнуванню:»
    Range(«A» + CStr(i + 1)) = » за період з » & Cells(4, 3) & » р. по » & Cells(4, 4) & » р. були нараховані відсотки в сумі:»
    Range(«A» + CStr(i + 2)) = » » & Format(Cells(6, 6), «0.00») & » /» & Cells(6, 5) & » » & day_txt & «*» & Cells(4, 5) & » » & day_txt & » = » & Format(Cells(4, 6), «0.00») & » грн.»
    If Cells(4, 7) «» Then
    Range(«B» + CStr(i)) = «Розрахунок нарахованого штрафу, який підлягає сторнуванню:»
    Range(«B» + CStr(i + 1)) = » за період з » & Cells(4, 3) & » р. по » & Cells(4, 4) & » р. було нараховано штраф в сумі:»
    Range(«B» + CStr(i + 2)) = » » & Format(Cells(6, 7), «0.00») & » /» & Cells(6, 5) & » » & day_txt & «*» & Cells(4, 5) & » » & day_txt & » = » & Format(Cells(4, 7), «0.00») & » грн.»
    End If
    i = i + 4
    j = 7
    Do While Cells(j, 3) «»
    ‘If Int(Month(Cells(j, 3)) / 3) Int(Month(Cells(j — 1, 3)) / 3) Then
    day_num = Cells(j, 5)
    ‘ If day_num 31 Then day_txt = «дня»
    day_txt = «дн.»
    If Cells(j, 6) «» Then
    Range(«A» + CStr(i)) = «Розрахунок нарахованих відсотків, які підлягають сторнуванню:»
    Range(«A» + CStr(i + 1)) = » за період з » & Cells(j, 3) & » р. по » & Cells(j, 4) & » р. були нараховані відсотки в сумі:»
    Range(«A» + CStr(i + 2)) = » » & Format(Cells(j, 6), «0.00») & » /» & Cells(j, 5) & » » & day_txt & «*» & Cells(j, 5) & » » & day_txt & » = » & Format(Cells(j, 6), «0.00») & » грн.»
    End If
    If Cells(j, 7) «» Then
    Range(«B» + CStr(i)) = «Розрахунок нарахованого штрафу, який підлягає сторнуванню:»
    Range(«B» + CStr(i + 1)) = » за період з » & Cells(j, 3) & » р. по » & Cells(j, 4) & » р. було нараховано штраф в сумі:»
    Range(«B» + CStr(i + 2)) = » » & Format(Cells(j, 7), «0.00») & » /» & Cells(j, 5) & » » & day_txt & «*» & Cells(j, 5) & » » & day_txt & » = » & Format(Cells(j, 7), «0.00») & » грн.»
    End If
    i = i + 4
    ‘ End If
    j = j + 1
    Loop
    End Sub
    Sub Kvartals()
    ‘Call shablon_clear
    i = 1
    Do While Sheets(3).Cells(i, 1) «Account #:» And Sheets(3).Cells(i, 1) «Счет №:» And Sheets(3).Cells(i, 1) «Рахунок №:»
    i = i + 1
    Loop
    Account = «»
    For j = 1 To Len(Sheets(3).Cells(i, 2))
    If IsNumeric(Mid(Sheets(3).Cells(i, 2), j, 1)) = True Then
    Account = Account & Mid(Sheets(3).Cells(i, 2), j, 1)
    End If
    Next
    Code = Form_KK.TextBox22.Value
    PIB = Form_KK.TextBox17.Value
    KR = Form_KK.TextBox19.Value
    Data_KR = Form_KK.TextBox20.Value
    startday = Sheets(1).Cells(4, 3)
    Data_mob = Sheets(1).Cells(4, 3)
    sum_proc = Sheets(1).Cells(4, 6)
    sum_shtraf = Sheets(1).Cells(4, 7)
    Proc_Ruh_Dt = Form_KK.TextBox1
    Proc_EDRPOY_Dt = Form_KK.TextBox2
    Proc_MFO_Dt = Form_KK.TextBox3
    Proc_Ruh_Kt = Form_KK.TextBox4
    Proc_EDRPOY_Kt = Form_KK.TextBox5
    Proc_MFO_Kt = Form_KK.TextBox6
    Shtraf_Ruh_Dt = Form_KK.TextBox7
    Shtraf_EDRPOY_Dt = Form_KK.TextBox8
    Shtraf_MFO_Dt = Form_KK.TextBox9
    Shtraf_Ruh_Kt = Form_KK.TextBox10
    Shtraf_EDRPOY_Kt = Form_KK.TextBox11
    Shtraf_MFO_Kt = Form_KK.TextBox12
    j = 2
    kv = 1
    Sheets(4).Cells(j, 1) = kv
    g = 1
    Do While Sheets(1).Cells(g, 1) Like «*» & startday & «*» = False
    g = g + 1
    Loop
    Sheets(4).Cells(j + 5, 1) = Sheets(1).Cells(g, 1)
    Sheets(4).Cells(j + 6, 1) = Sheets(1).Cells(g + 1, 1)
    Sheets(4).Cells(6, 1) = «Розрахунок нарахованих відсотків, які підлягають сторнуванню:»
    Sheets(4).Cells((kv — 1) * 13 + 4, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків » & «за період з » & startday & » по » & Sheets(1).Cells(4, 4).Value & » за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    Sheets(4).Cells((kv — 1) * 13 + 2, 2) = Proc_Ruh_Dt
    Sheets(4).Cells((kv — 1) * 13 + 2, 3) = Proc_EDRPOY_Dt
    Sheets(4).Cells((kv — 1) * 13 + 2, 4) = Proc_MFO_Dt
    Sheets(4).Cells((kv — 1) * 13 + 2, 5) = Proc_Ruh_Kt
    Sheets(4).Cells((kv — 1) * 13 + 2, 6) = Proc_MFO_Kt
    Sheets(4).Cells((kv — 1) * 13 + 2, 7) = Proc_EDRPOY_Kt
    Sheets(4).Cells((kv — 1) * 13 + 2, 8) = Format(sum_proc, «0.00»)
    Sheets(4).Cells((kv — 1) * 13 + 2, 9) = 980
    Sheets(4).Cells((kv — 1) * 13 + 2, 10) = «з » & startday & » по » & Sheets(1).Cells(4, 4).Value
    startday = Sheets(1).Cells(6, 3)
    If Sheets(1).Cells(6, 7) «» Then startday_p = Sheets(1).Cells(6, 3)
    i = 7
    Do While Sheets(1).Cells(i, 3) «»
    If Int(Month(startday) / 3) = Int(Month(Sheets(1).Cells(i, 3)) / 3) Then
    ‘текущий квартал
    sum_proc = sum_proc + Sheets(1).Cells(i, 6)
    g = 1
    Do While Sheets(1).Cells(g, 1) Like «*» & Sheets(1).Cells(i, 3).Value & «*» = False
    g = g + 1
    Loop
    j = 7 + (kv — 1) * 13
    Sheets(4).Cells((kv — 1) * 13 + 2, 1) = kv
    Sheets(4).Cells(j — 1, 1) = «Розрахунок нарахованих відсотків, які підлягають сторнуванню:»
    Do While Sheets(4).Cells(j, 1) «»
    j = j + 1
    Loop
    Sheets(4).Cells(j, 1) = Sheets(1).Cells(g, 1)
    Sheets(4).Cells(j + 1, 1) = Sheets(1).Cells(g + 1, 1)
    Sheets(4).Cells((kv — 1) * 13 + 4, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків » & «за період з » & startday & » по » & Sheets(1).Cells(i, 4).Value & » за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    Sheets(4).Cells((kv — 1) * 13 + 2, 2) = Proc_Ruh_Dt
    Sheets(4).Cells((kv — 1) * 13 + 2, 3) = Proc_EDRPOY_Dt
    Sheets(4).Cells((kv — 1) * 13 + 2, 4) = Proc_MFO_Dt
    Sheets(4).Cells((kv — 1) * 13 + 2, 5) = Proc_Ruh_Kt
    Sheets(4).Cells((kv — 1) * 13 + 2, 6) = Proc_MFO_Kt
    Sheets(4).Cells((kv — 1) * 13 + 2, 7) = Proc_EDRPOY_Kt
    Sheets(4).Cells((kv — 1) * 13 + 2, 8) = Format(sum_proc, «0.00»)
    Sheets(4).Cells((kv — 1) * 13 + 2, 9) = 980
    Sheets(4).Cells((kv — 1) * 13 + 2, 10) = «з » & startday & » по » & Sheets(1).Cells(i, 4).Value

    Else

    sum_proc = Sheets(1).Cells(i, 6)

    startday_p = «»
    ‘след. квартал
    startday = Sheets(1).Cells(i, 3).Value
    If Sheets(1).Cells(i, 7).Value «» Then
    startday_p = Sheets(1).Cells(i, 3)
    finishday_p = Sheets(1).Cells(i, 4)
    End If
    kv = kv + 1

    Do While Sheets(1).Cells(g, 1) Like «*» & Sheets(1).Cells(i, 3).Value & «*» = False
    g = g + 1
    Loop
    j = 7 + (kv — 1) * 13
    Sheets(4).Cells((kv — 1) * 13 + 2, 1) = kv
    Sheets(4).Cells(j — 1, 1) = «Розрахунок нарахованих відсотків, які підлягають сторнуванню:»
    Do While Sheets(4).Cells(j, 1) «»
    j = j + 1
    Loop
    Sheets(4).Cells(j, 1) = Sheets(1).Cells(g, 1)
    Sheets(4).Cells(j + 1, 1) = Sheets(1).Cells(g + 1, 1)

    Sheets(4).Cells((kv — 1) * 13 + 4, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків » & «за період з » & startday & » по » & Sheets(1).Cells(i, 4).Value & » за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    Sheets(4).Cells((kv — 1) * 13 + 2, 2) = Proc_Ruh_Dt
    Sheets(4).Cells((kv — 1) * 13 + 2, 3) = Proc_EDRPOY_Dt
    Sheets(4).Cells((kv — 1) * 13 + 2, 4) = Proc_MFO_Dt
    Sheets(4).Cells((kv — 1) * 13 + 2, 5) = Proc_Ruh_Kt
    Sheets(4).Cells((kv — 1) * 13 + 2, 6) = Proc_MFO_Kt
    Sheets(4).Cells((kv — 1) * 13 + 2, 7) = Proc_EDRPOY_Kt

    Sheets(4).Cells((kv — 1) * 13 + 2, 8) = Format(sum_proc, «0.00»)
    Sheets(4).Cells((kv — 1) * 13 + 2, 9) = 980
    Sheets(4).Cells((kv — 1) * 13 + 2, 10) = «з » & startday & » по » & Sheets(1).Cells(i, 4).Value

    End If
    i = i + 1
    Loop

    lastrow = j + 1

    j = 2

    startday = Sheets(1).Cells(4, 3)
    If Sheets(1).Cells(4, 7).Value «» Then

    g = 5
    j = 7 + kv * 13
    Sheets(4).Cells(kv * 13 + 2, 1) = kv + 1
    Do While Sheets(4).Cells(j, 1) «»
    j = j + 1
    Loop
    Sheets(4).Cells(j, 1) = Sheets(1).Cells(g, 2)
    Sheets(4).Cells(j + 1, 1) = Sheets(1).Cells(g + 1, 2)
    Sheets(4).Cells(kv * 13 + 6, 1) = «Розрахунок нарахованого штрафу, який підлягає сторнуванню:»

    Sheets(4).Cells(kv * 13 + 4, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню нарахованого штрафу » & «за період з » & startday & » по » & Sheets(1).Cells(4, 4).Value & » за несвоєчасний обов’язковий платіж за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    Sheets(4).Cells(kv * 13 + 2, 2) = Shtraf_Ruh_Dt
    Sheets(4).Cells(kv * 13 + 2, 3) = Shtraf_EDRPOY_Dt
    Sheets(4).Cells(kv * 13 + 2, 4) = Shtraf_MFO_Dt
    Sheets(4).Cells(kv * 13 + 2, 5) = Shtraf_Ruh_Kt
    Sheets(4).Cells(kv * 13 + 2, 6) = Shtraf_MFO_Kt
    Sheets(4).Cells(kv * 13 + 2, 7) = Shtraf_EDRPOY_Kt

    Sheets(4).Cells(kv * 13 + 2, 8) = Format(sum_shtraf, «0.00»)
    Sheets(4).Cells(kv * 13 + 2, 9) = 980
    Sheets(4).Cells(kv * 13 + 2, 10) = «з » & startday & » по » & Sheets(1).Cells(4, 4).Value
    kv = kv + 1
    End If

    startday = Sheets(1).Cells(6, 3)
    If Sheets(1).Cells(6, 7) «» Then startday_p = Sheets(1).Cells(6, 3)
    kv = kv — 1
    i = 7
    Do While Sheets(1).Cells(i, 3) «»
    If Sheets(1).Cells(i, 7) «» Then
    If Int(Month(startday) / 3) = Int(Month(Sheets(1).Cells(i, 3)) / 3) Then
    g = 1
    Do While Sheets(1).Cells(g, 2) Like «*» & Sheets(1).Cells(i, 3).Value & «*» = False
    g = g + 1
    Loop
    If Sheets(1).Cells(g, 2).Value «» Then
    sum_shtraf = sum_shtraf + Sheets(1).Cells(i, 7)
    If startday_p = «» Then startday_p = Sheets(1).Cells(i, 3)
    finishday_p = Sheets(1).Cells(i, 4)
    j = 7 + kv * 13
    Sheets(4).Cells(kv * 13 + 2, 1) = kv + 1
    Sheets(4).Cells(j — 1, 1) = «Розрахунок нарахованого штрафу, який підлягає сторнуванню:»
    Do While Sheets(4).Cells(j, 1) «»
    j = j + 1
    Loop
    Sheets(4).Cells(j, 1) = Sheets(1).Cells(g, 2)
    Sheets(4).Cells(j + 1, 1) = Sheets(1).Cells(g + 1, 2)

    Sheets(4).Cells(kv * 13 + 4, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню нарахованого штрафу » & «за період з » & startday_p & » по » & Sheets(1).Cells(i, 4).Value & » за несвоєчасний обов’язковий платіж за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    Sheets(4).Cells(kv * 13 + 2, 2) = Shtraf_Ruh_Dt
    Sheets(4).Cells(kv * 13 + 2, 3) = Shtraf_EDRPOY_Dt
    Sheets(4).Cells(kv * 13 + 2, 4) = Shtraf_MFO_Dt
    Sheets(4).Cells(kv * 13 + 2, 5) = Shtraf_Ruh_Kt
    Sheets(4).Cells(kv * 13 + 2, 6) = Shtraf_MFO_Kt
    Sheets(4).Cells(kv * 13 + 2, 7) = Shtraf_EDRPOY_Kt

    Sheets(4).Cells(kv * 13 + 2, 8) = Format(sum_shtraf, «0.00»)
    Sheets(4).Cells(kv * 13 + 2, 9) = 980
    Sheets(4).Cells(kv * 13 + 2, 10) = «з » & startday_p & » по » & Sheets(1).Cells(i, 4).Value
    End If

    Else

    sum_shtraf = Sheets(1).Cells(i, 7)
    startday_p = «»
    startday = Sheets(1).Cells(i, 3).Value
    If Sheets(1).Cells(i, 7).Value «» Then
    startday_p = Sheets(1).Cells(i, 3)
    finishday_p = Sheets(1).Cells(i, 4)
    End If
    kv = kv + 1
    ‘If Sheets(4).Cells((kv — 1) * 13 + 2, 1) «» Then
    ‘kv = kv + 1
    ‘Sheets(4).Cells((kv — 1) * 13 + 2, 1) = kv
    ‘Else
    ‘ Sheets(4).Cells((kv — 1) * 13 + 2, 1) = kv
    ‘ End If
    g = 1
    Do While Sheets(1).Cells(g, 2) Like «*» & Sheets(1).Cells(i, 3).Value & «*» = False
    g = g + 1
    Loop

    If Sheets(1).Cells(g, 2).Value «» Then
    j = 7 + kv * 13
    Sheets(4).Cells(kv * 13 + 2, 1) = kv + 1
    Sheets(4).Cells(j — 1, 1) = «Розрахунок нарахованого штрафу, який підлягає сторнуванню:»
    Do While Sheets(4).Cells(j, 1) «»
    j = j + 1
    Loop
    Sheets(4).Cells(j, 1) = Sheets(1).Cells(g, 2)
    Sheets(4).Cells(j + 1, 1) = Sheets(1).Cells(g + 1, 2)

    Sheets(4).Cells(kv * 13 + 4, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню нарахованого штрафу » & «за період з » & startday_p & » по » & finishday_p & » за несвоєчасний обов’язковий платіж за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    Sheets(4).Cells(kv * 13 + 2, 2) = Shtraf_Ruh_Dt
    Sheets(4).Cells(kv * 13 + 2, 3) = Shtraf_EDRPOY_Dt
    Sheets(4).Cells(kv * 13 + 2, 4) = Shtraf_MFO_Dt
    Sheets(4).Cells(kv * 13 + 2, 5) = Shtraf_Ruh_Kt
    Sheets(4).Cells(kv * 13 + 2, 6) = Shtraf_MFO_Kt
    Sheets(4).Cells(kv * 13 + 2, 7) = Shtraf_EDRPOY_Kt

    Sheets(4).Cells(kv * 13 + 2, 8) = Format(sum_shtraf, «0.00»)
    Sheets(4).Cells(kv * 13 + 2, 9) = 980
    Sheets(4).Cells(kv * 13 + 2, 10) = «з » & startday_p & » по » & finishday_p
    End If
    End If
    End If
    i = i + 1
    Loop
    data_finish = Sheets(1).Cells(i — 1, 4)
    If j 2 Then lastrow = j + 1
    End Sub

    Sub shablon_clear()
    i = 2
    Do While Sheets(4).Cells(i, 1) «»
    Sheets(4).Range(«A» & i & «:J» & i).ClearContents
    Sheets(4).Range(«A» + CStr(i + 2)).Value = «»
    Sheets(4).Range(«A» & i + 5 & «:A» & i + 11).ClearContents
    i = i + 13
    Loop
    End Sub

    Sub shablon_clear2()
    ‘i = 2
    ‘Do While Sheets(4).Cells(i, 1) «»
    ‘ Sheets(4).Range(«A» & i & «:J» & i).ClearContents
    ‘ Sheets(4).Range(«A» + CStr(i + 2)).Value = «»
    ‘ If i 264 Then Sheets(4).Range(«A» & i + 5 & «:A» & i + 28).ClearContents
    ‘ If i 264 Then
    ‘ i = i + 31
    ‘ Else
    ‘ i = i + 5
    ‘ End If
    ‘Loop


    ‘Sheets(4).Rows(«38:62»).ClearContents
    ‘Sheets(4).Rows(«74:98»).ClearContents
    ‘Sheets(4).Rows(«105:128»).ClearContents

    For i = 2 To 700
    If Sheets(4).Cells(i, 1) Like «*п/п*» Or Sheets(4).Cells(i, 1) Like «*Призначення:*» Or Sheets(4).Cells(i, 1) Like «*які підлягають сторнуванню*» Or Sheets(4).Cells(i, 1) Like «*який підлягає сторнуванню*» Then

    Else
    Sheets(4).Range(«A» & i & «:J» & i).ClearContents
    Sheets(4).Range(«A» + CStr(i)).Value = «»
    End If
    Next

    End Sub

    Sub test()

    Else
    Range(«A» + CStr(i)) = » за період з » & Cells(j, 3) & » р. по » & Cells(j, 4) & » р. були нараховані відсотки в сумі»
    Range(«A» + CStr(i + 1)) = » » & Format(Cells(j, 6), «0.00») & » /» & Cells(j, 5) & » днів*» & Cells(j, 5) & » днів = » & Format(Cells(j, 6), «0.00») & » грн.»

    If Cells(j, 7) «» And Cells(j — 1, 2) «» Then
    Range(«B» + CStr(i)) = » за період з » & Cells(j, 3) & » р. по » & Cells(j, 4) & » р. були нараховані відсотки в сумі»
    Range(«B» + CStr(i + 1)) = » » & Format(Cells(j, 7), «0.00») & » /» & Cells(j, 5) & » днів*» & Cells(j, 5) & » днів = » & Format(Cells(j, 7), «0.00») & » грн.»
    End If
    If Cells(j, 7) «» And Cells(j — 1, 2) = «» Then
    Range(«B» + CStr(i)) = «Розрахунок нарахованого штрафу, який підлягає сторнуванню:»
    Range(«B» + CStr(i + 1)) = » за період з » & Cells(j, 3) & » р. по » & Cells(j, 4) & » р. були нараховані відсотки в сумі»
    Range(«B» + CStr(i + 2)) = » » & Format(Cells(j, 7), «0.00») & » /» & Cells(j, 5) & » днів*» & Cells(j, 5) & » днів = » & Format(Cells(j, 7), «0.00») & » грн.»
    End If

    i = i + 2
    End If
    End Sub

    Sub preparation_excel()

    Call shablon_clear2

    i = 6
    Sheets(1).Cells(1, 26) = Year(Sheets(1).Cells(i, 4))
    Do While Sheets(1).Cells(i, 4) «»
    If Sheets(1).Cells(1, 26) Year(Sheets(1).Cells(i, 4)) Then Sheets(1).Cells(2, 26) = Year(Sheets(1).Cells(i, 4))
    i = i + 1
    Loop
    MinYear = Sheets(1).Cells(1, 26)
    MaxYear = Sheets(1).Cells(2, 26)
    If MinYear = MaxYear Then MinYear = «»

    i = 1
    Do While Sheets(3).Cells(i, 1) «Account #:» And Sheets(3).Cells(i, 1) «Счет №:» And Sheets(3).Cells(i, 1) «Рахунок №:»
    i = i + 1
    Loop
    Account = «»
    For j = 1 To Len(Sheets(3).Cells(i, 2))
    If IsNumeric(Mid(Sheets(3).Cells(i, 2), j, 1)) = True Then
    Account = Account & Mid(Sheets(3).Cells(i, 2), j, 1)
    End If
    Next

    Code = Form_KK.TextBox22.Value
    PIB = Form_KK.TextBox17.Value
    KR = Form_KK.TextBox19.Value
    Data_KR = Form_KK.TextBox20.Value

    startday = Sheets(1).Cells(4, 3)
    Data_mob = Sheets(1).Cells(4, 3)

    sum_proc = Sheets(1).Cells(4, 6)
    sum_shtraf = Sheets(1).Cells(4, 7)

    Proc_Ruh_Dt2014 = Form_KK.TextBox31

    Proc_Ruh_Dt1 = Form_KK.TextBox1
    Proc_EDRPOY_Dt1 = Form_KK.TextBox2
    Proc_MFO_Dt1 = Form_KK.TextBox3
    Proc_Ruh_Kt1 = Form_KK.TextBox4
    Proc_EDRPOY_Kt1 = Form_KK.TextBox5
    Proc_MFO_Kt1 = Form_KK.TextBox6

    Proc_Ruh_Kt2 = Form_KK.TextBox24
    Proc_EDRPOY_Kt2 = Form_KK.TextBox25
    Proc_MFO_Kt2 = Form_KK.TextBox26
    Proc_Ruh_Dt2 = Form_KK.TextBox27
    Proc_EDRPOY_Dt2 = Form_KK.TextBox28
    Proc_MFO_Dt2 = Form_KK.TextBox29

    Shtraf_Ruh_Dt2014 = Form_KK.TextBox30

    Shtraf_Ruh_Dt = Form_KK.TextBox7
    Shtraf_EDRPOY_Dt = Form_KK.TextBox8
    Shtraf_MFO_Dt = Form_KK.TextBox9
    Shtraf_Ruh_Kt = Form_KK.TextBox10
    Shtraf_EDRPOY_Kt = Form_KK.TextBox11
    Shtraf_MFO_Kt = Form_KK.TextBox12

    ‘procents
    j = 6
    i = 4
    i14 = 7
    i15 = 138
    NumN = 1
    Sheets(4).Cells(2, 9) = 980
    Sheets(4).Cells(133, 9) = 980
    Sheets(4).Cells(264, 9) = 980
    Sheets(4).Cells(269, 9) = 980
    Sheets(4).Cells(321, 9) = 980
    Sheets(4).Cells(451, 9) = 980

    If Year(Sheets(1).Cells(j, 4)) 2016 Then
    flag2014 = True
    Sheets(4).Cells(2, 1) = NumN
    NumN = NumN + 1
    Sheets(4).Cells(2, 2) = Proc_Ruh_Dt2014
    Sheets(4).Cells(2, 3) = Proc_EDRPOY_Dt1
    Sheets(4).Cells(2, 4) = Proc_MFO_Dt1

    Sheets(4).Cells(2, 5) = Proc_Ruh_Kt1
    Sheets(4).Cells(2, 6) = Proc_MFO_Kt1
    Sheets(4).Cells(2, 7) = Proc_EDRPOY_Kt1
    Sheets(4).Cells(4, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    If Proc_Ruh_Dt1 «нет» Then
    Sheets(4).Cells(133, 1) = NumN
    NumN = NumN + 1
    Sheets(4).Cells(133, 2) = Proc_Ruh_Dt1
    Sheets(4).Cells(133, 3) = Proc_EDRPOY_Dt1
    Sheets(4).Cells(133, 4) = Proc_MFO_Dt1

    Sheets(4).Cells(133, 5) = Proc_Ruh_Kt1
    Sheets(4).Cells(133, 6) = Proc_MFO_Kt1
    Sheets(4).Cells(133, 7) = Proc_EDRPOY_Kt1
    Sheets(4).Cells(135, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    End If
    g = 7
    t = 7
    symma = Round(Sheets(1).Cells(4, 6), 2)
    If Year(Sheets(1).Cells(4, 4)) 2016 Then
    symma15 = 0
    Else
    symma15 = Round(Sheets(1).Cells(4, 6), 2)
    End If
    Do While Sheets(1).Cells(g, 4) «»

    If Year(Sheets(1).Cells(g, 4)) 2016 Then
    symma = symma + Round(Sheets(1).Cells(g, 6), 2)
    t = g
    Else
    symma15 = symma15 + Round(Sheets(1).Cells(g, 6), 2)
    End If
    g = g + 1
    Loop
    Do While Sheets(1).Cells(g, 6) = «»
    g = g — 1
    Loop
    g = g + 1

    Sheets(4).Cells(2, 8) = symma
    Sheets(4).Cells(2, 10) = «з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(t, 4), «dd.mm.yyyy»)

    Sheets(4).Cells(4, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків » & «за період з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(t, 4), «dd.mm.yyyy») & » за користування кредитом, № » & KR & » від » & Data_KR & » р.»

    Sheets(4).Cells(133, 8) = symma15
    Sheets(4).Cells(133, 10) = «з » & Format(Sheets(1).Cells(t + 1, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(g — 1, 4), «dd.mm.yyyy»)
    Sheets(4).Cells(135, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків » & «за період з » & Format(Sheets(1).Cells(t + 1, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(g — 1, 4), «dd.mm.yyyy») & » за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    Else

    flag2014 = False

    Sheets(4).Cells(133, 1) = NumN
    NumN = NumN + 1
    Sheets(4).Cells(133, 2) = Proc_Ruh_Dt1
    Sheets(4).Cells(133, 3) = Proc_EDRPOY_Dt1
    Sheets(4).Cells(133, 4) = Proc_MFO_Dt1

    Sheets(4).Cells(133, 5) = Proc_Ruh_Kt1
    Sheets(4).Cells(133, 6) = Proc_MFO_Kt1
    Sheets(4).Cells(133, 7) = Proc_EDRPOY_Kt1
    Sheets(4).Cells(135, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    g = 7
    t = 7
    symma = 0
    If Year(Sheets(1).Cells(4, 4)) 2016 Then
    symma15 = 0
    Else
    symma15 = Round(Sheets(1).Cells(4, 6), 2)
    End If
    Do While Sheets(1).Cells(g, 4) «»

    If Year(Sheets(1).Cells(g, 4)) 2016 Then
    symma = symma + Round(Sheets(1).Cells(g, 6), 2)
    t = g
    Else
    symma15 = symma15 + Round(Sheets(1).Cells(g, 6), 2)
    End If
    g = g + 1
    Loop
    Do While Sheets(1).Cells(g, 6) = «»
    g = g — 1
    Loop
    g = g + 1

    Sheets(4).Cells(2, 8) = symma
    Sheets(4).Cells(2, 9) = 980
    Sheets(4).Cells(2, 10) = «з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(t, 4), «dd.mm.yyyy»)

    Sheets(4).Cells(133, 8) = symma15
    Sheets(4).Cells(133, 9) = 980
    If Year(Sheets(1).Cells(4, 4)) 2016 Then
    Sheets(4).Cells(133, 10) = «з » & Format(Sheets(1).Cells(t + 1, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(g — 1, 4), «dd.mm.yyyy»)
    Sheets(4).Cells(135, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків » & «за період з » & Format(Sheets(1).Cells(t + 1, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(g — 1, 4), «dd.mm.yyyy») & » за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    Else
    Sheets(4).Cells(133, 10) = «з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(g — 1, 4), «dd.mm.yyyy»)
    Sheets(4).Cells(135, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків » & «за період з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(g — 1, 4), «dd.mm.yyyy») & » за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    End If
    End If

    Do While Sheets(1).Cells(j, 3) «»
    If Sheets(1).Cells(j, 6) «» Then
    Do While Sheets(1).Cells(i, 1) Like «*» & Sheets(1).Cells(j, 4) & «*» = False
    i = i + 1
    Loop

    If Year(Sheets(1).Cells(j, 4)) 2016 Then
    Sheets(4).Cells(i14, 1) = Sheets(1).Cells(i, 1)
    Sheets(4).Cells(i14 + 1, 1) = Sheets(1).Cells(i + 1, 1)
    i14 = i14 + 2
    Else
    Sheets(4).Cells(i15, 1) = Sheets(1).Cells(i, 1)
    Sheets(4).Cells(i15 + 1, 1) = Sheets(1).Cells(i + 1, 1)
    i15 = i15 + 2
    End If
    End If
    j = j + 1
    Loop

    Sheets(4).Cells(264, 1) = NumN
    NumN = NumN + 1
    Sheets(4).Cells(264, 2) = Proc_Ruh_Dt2
    Sheets(4).Cells(264, 3) = Proc_EDRPOY_Dt2
    Sheets(4).Cells(264, 4) = Proc_MFO_Dt2

    Sheets(4).Cells(264, 5) = Proc_Ruh_Kt2
    Sheets(4).Cells(264, 6) = Proc_MFO_Kt2
    Sheets(4).Cells(264, 7) = Proc_EDRPOY_Kt2

    Sheets(4).Cells(264, 8) = symma15 + symma
    Sheets(4).Cells(264, 9) = 980
    Sheets(4).Cells(264, 10) = «з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(g — 1, 4), «dd.mm.yyyy»)
    Sheets(4).Cells(266, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню надмірно нарахованих відсотків » & «за період з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(g — 1, 4), «dd.mm.yyyy») & » за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    ‘shtraf
    j = 6
    i = 4
    i14 = 274
    i15 = 326

    If Year(Sheets(1).Cells(j, 4)) 2016 Then
    flag2014 = True

    Else
    flag2014 = False
    End If
    flag = False
    Sheets(4).Cells(269, 8) = 0
    Sheets(4).Cells(321, 8) = 0
    Do While Sheets(1).Cells(j, 3) «»
    If Sheets(1).Cells(j, 7) «» Then
    Do While Sheets(1).Cells(i, 2) Like «*» & Sheets(1).Cells(j, 4) & «*» = False
    i = i + 1
    Loop

    If Year(Sheets(1).Cells(j, 4)) 2016 Then
    If Sheets(4).Cells(269, 1) = «» Then
    Sheets(4).Cells(269, 1) = NumN
    NumN = NumN + 1
    End If
    Sheets(4).Cells(269, 2) = Shtraf_Ruh_Dt2014
    Sheets(4).Cells(269, 3) = Shtraf_EDRPOY_Dt
    Sheets(4).Cells(269, 4) = Shtraf_MFO_Dt

    Sheets(4).Cells(269, 5) = Shtraf_Ruh_Kt
    Sheets(4).Cells(269, 6) = Shtraf_MFO_Kt
    Sheets(4).Cells(269, 7) = Shtraf_EDRPOY_Kt

    If g = 6 Then
    Sheets(4).Cells(269, 8) = Sheets(4).Cells(269, 8) + Sheets(1).Cells(4, 7)
    Else
    Sheets(4).Cells(269, 8) = Sheets(4).Cells(269, 8) + Sheets(1).Cells(j, 7)
    End If
    Sheets(4).Cells(269, 9) = 980
    Sheets(4).Cells(269, 10) = «з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(j, 4), «dd.mm.yyyy»)
    Sheets(4).Cells(271, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню нарахованого штрафу » & «за період з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(j, 4), «dd.mm.yyyy») & » за несвоєчасний обов’язковий платіж за користування кредитом, № » & KR & » від » & Data_KR & » р.»

    Sheets(4).Cells(i14, 1) = Sheets(1).Cells(i, 2)
    Sheets(4).Cells(i14 + 1, 1) = Sheets(1).Cells(i + 1, 2)
    i14 = i14 + 2
    Else
    If flag = False Then
    jj = j
    flag = True
    If flag2014 = False And Sheets(1).Cells(4, 7) «» Then jj = 4
    End If

    If Sheets(4).Cells(321, 1) = «» Then
    Sheets(4).Cells(321, 1) = NumN
    NumN = NumN + 1
    End If

    Sheets(4).Cells(321, 2) = Shtraf_Ruh_Dt
    Sheets(4).Cells(321, 3) = Shtraf_EDRPOY_Dt
    Sheets(4).Cells(321, 4) = Shtraf_MFO_Dt

    Sheets(4).Cells(321, 5) = Shtraf_Ruh_Kt
    Sheets(4).Cells(321, 6) = Shtraf_MFO_Kt
    Sheets(4).Cells(321, 7) = Shtraf_EDRPOY_Kt

    If g = 6 Then
    Sheets(4).Cells(321, 8) = Sheets(4).Cells(321, 8) + Sheets(1).Cells(4, 7)
    Else
    Sheets(4).Cells(321, 8) = Sheets(4).Cells(321, 8) + Sheets(1).Cells(j, 7)
    End If
    Sheets(4).Cells(321, 9) = 980
    ‘ If flag2014 = True Then
    ‘ Sheets(4).Cells(321, 10) = «з » & Format(Sheets(1).Cells(4, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(j, 4), «dd.mm.yyyy»)
    ‘ Else
    Sheets(4).Cells(321, 10) = «з » & Format(Sheets(1).Cells(jj, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(j, 4), «dd.mm.yyyy»)
    Sheets(4).Cells(323, 1) = «/~» & Code & «~» & Account & «~» & PIB & » ~/виправна проводка по поверненню нарахованого штрафу » & «за період з » & Format(Sheets(1).Cells(jj, 3), «dd.mm.yyyy») & » по » & Format(Sheets(1).Cells(j, 4), «dd.mm.yyyy») & » за несвоєчасний обов’язковий платіж за користування кредитом, № » & KR & » від » & Data_KR & » р.»
    ‘ End If
    Sheets(4).Cells(i15, 1) = Sheets(1).Cells(i, 2)
    Sheets(4).Cells(i15 + 1, 1) = Sheets(1).Cells(i + 1, 2)
    i15 = i15 + 2
    End If
    End If
    j = j + 1
    Loop

    If Sheets(4).Cells(2, 1) = «» Then
    Sheets(4).Rows(1 & «:» & 31).EntireRow.Hidden = True
    Else
    For i = 7 To 130
    If Sheets(4).Cells(i, 1) = «» Then Sheets(4).Rows(i & «:» & i).EntireRow.Hidden = True
    Next
    End If

    If Sheets(4).Cells(133, 1) = «» Then
    Sheets(4).Rows(132 & «:» & 262).EntireRow.Hidden = True
    Else
    For i = 138 To 261
    If Sheets(4).Cells(i, 1) = «» Then Sheets(4).Rows(i & «:» & i).EntireRow.Hidden = True
    Next
    End If

    If Sheets(4).Cells(269, 1) = «» Then
    Sheets(4).Rows(268 & «:» & 298).EntireRow.Hidden = True
    Else
    For i = 274 To 318
    If Sheets(4).Cells(i, 1) = «» Then Sheets(4).Rows(i & «:» & i).EntireRow.Hidden = True
    Next
    End If

    If Sheets(4).Cells(321, 1) = «» Then
    Sheets(4).Rows(299 & «:» & 427).EntireRow.Hidden = True
    Else
    For i = 326 To 427
    If Sheets(4).Cells(i, 1) = «» Then Sheets(4).Rows(i & «:» & i).EntireRow.Hidden = True
    Next
    End If
    data_finish = Sheets(1).Cells(j — 1, 4)

    Do While Sheets(1).Cells(j, 6) = «»
    j = j — 1
    Loop
    data_finish = Sheets(1).Cells(j, 4)
    End Sub

  27. Ренат, приветствую!
    решились мы на небольшую оптимизацию в работе с нашими клиентами, а именно, все входящие обращения от потребителей, для учета, «заводим» в Ексель. Так удобнее контролировать сроки предоставления ответов.
    Так вот, во вложении пример реестра входящих обращений, напротив каждого обращения были созданы кнопки ActiveX при нажатии на которую автоматом формируется письмо в Outlook’е для отправки (шаблон нашего ответа из ячейки и ниже текст обращения потребителя). Это всё для оперативности работы с потребителями, так как в день принимаем до 40-50 обращений.
    Единственный минус этого реестра — необходимость каждый раз создавать новую кнопку с корректировкой кода (ссылок на ячейки):

    Private Sub CommandButton2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim OutlookApp As Object, SM As Object
    Set OutlookApp = CreateObject(«Outlook.Application»)
    Set SM = OutlookApp.CreateItem(olMailItem)
    SM.To = Range(«D4»).Value
    SM.Subject = «ОТВЕТ НА ОБРАЩЕНИЕ»
    On Error Resume Next
    SM.Body = Range(«J4″).Value & » __________________________ » & Range(«E4»).Value
    SM.Display
    Set SM = Nothing
    Set OutlookApp = Nothing
    End Sub

    В этом случае оптимизации никакой…

    Вопрос: есть ли возможность копирования кнопки ActiveX в новой строке без переписывания кода???

    Очень нам поможете!!!

    Файл:  .xlsx

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *