Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Создание письма из Excel с вложенной книгой и таблицей
 
Уважаемые Знатоки!

Помогите, пожалуйста. Мне необходимо написать код, который будет
1. Сохранять файл с заданным имененем (как Subject письма), но при этом предлагать выбрать путь, куда его сохранить
2. Формировать письмо с текстом (как на листе Main, но не табличным вариантом, а именно текстом)
3. Вставлять 2 таблицы (1я таблица С17:J20,  2я таблица С22:D28 - сложнее, т.к. в ней может быть разное кол-во строк от 2х до "неизвенстно"
4. Вкладывать в письмо этот же самый файл, из которого делаем отправку
5. Добавлять подпись

У меня есть код, но работает он далеко не в полной мере, как надо. Он создает письмо, вставляет в тело только текст строки 4. Не могу найти вариант SaveAs, так чтобы имя файла задавалось автоматически. Ну и конечно же проблема с таблицами, их я как не крутила, ничего не получается :( Я даже пробовала прописать в sTable = Range("C18:J22").Copy а в тело вставить просто таблицу. Он ее скопировал, но не вставил :(

Код
Sub Send_Mail()

    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody1 As String, sBody2 As String, sBody3 As String, sTable As String, sAttachment As String, sCC As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    
    Set objMail = objOutlookApp.CreateItem(0)
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = Range("Q2").Value
    sCC = ""
    sSubject = Range("Q4").Value
    sBody1 = Range("C5").Value
    sBody2 = Range("C6").Value
    sBody3 = Range("C12").Value
    sTable = Range("C18:J22").Value
 
    With objMail
        .To = sTo
        .CC = ""
        .Subject = sSubject
        .body = sBody1
        .body = sBody2
        .body = sBody3
        .Table = sTable
        '.HTMLBody = sBody
        .Attachments.Add ActiveWorkbook.FullName
        .Display 'Send
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
    
MsgBox ("DONE")
End Sub
Изменено: Мария - - 19 ноя 2020 17:56:18
VBA. Удаление неопределенного количества столбцов
 
Уважаемые знатоки, простите, что опять беспокою.. но есть задача, которую не могу решить..
есть большая таблица.. нужно удалить столбцы, но количество столбцов все время меняется.. фиксированы только A:O.
Нужно удалить все колоки начиная с P до 1й желтой колонки (Overall result, с таким название колонок в таблице 2, одна в середине, другая в конце)
Вв примере под удаление колонки P:BB, но может быть и P:BA и P:AA...
А также последнюю колонку (которая тоже свой диапозон меняет в зависимости от кол-ва столбцов) поставить на место Q
Т.е. обе колонки Overall result должны быть рядом, но сначала должны быть литры, а следом рубли.

Я крутила/вертела.. пыталась протянуть название в 1й строке и по названию уже удалить.. но при использовании Ctrl-> ексель "залезает" на следующее название, которое удалять не нужно и заменять тоже..

конечно можно сделать это вручную, но этот шаг находится в середине полного кода макроса, т.е. это малая часть..  
VBA. Удаление строк, в которых непустая ячейка в столбце
 
Уважаемы Знатоки! Помогите, пожалуйста, ускорить макрос.
Задача: есть файл (пример прикреплен), в котором более 30 тысяч строк. По 2м полям нужно сделать проверку и удалить строки не проходящие ее.
В данном случае, нужно оставить строки, у которых колонка М пуста.
Мой код делает это оооочень долго на таком большом количестве строк. Помогите его ускорить. Возможно делать как это через фильтр.. но я не могу понять, как ему сказать какой диапазон потом удалять, ведь первая строка после шапки таблицы может быть не 2й, а например 44й

Я использую такой код:
Код
    Dim LastRow As Long, i As Long
    LastRow = Cells(Rows.Count, "M").End(xlUp).Row
    For i = LastRow To 2 Step -1
        If Cells(i, "M").Value <> "" Then Rows(i).Delete
    Next
VBA. Копировать/вставить данные из столбца по названию столбца
 
Уважаемы знатоки, помогите решить задачу. Есть 2 файла - 1 сбор данных за весь год, 2 выгрузка из системы (ежедневная).
Проблема заключается в том, что часть колонок может отличаться по количеству, но всегда имеет название. Например, сегодня в выгрузке 8 колонок, завтра 10.
В файле, в который инфо собирается есть все возможные колонки.
При чем первые 5 колонок статичны, они есть во всех выгрузках (например, название клиента, его код, дата, номер документа, номер продукта и тд).

Как собарть данные файлы в один? Желательно макрос, чтобы находил колонку в исходнике и вставлял данные в 1ю пустую строку исходя из кол-ва строк в колонке А

Пробовала через Power Query. да, все прекрасно, она собирает все файлы в один и ставит данные по нужным колонкам, НО сегодня я столкнулась с тем, что часть данных она дублирует. Я переповерила все исходники, дубликатов нет. А в выдаваемой таблице есть.. и очень много..

в файлах иходниках примерно по 3-3,5 тыс строк. Соотвественно, в основаном сейчас около 50тыс. Возможно Query из-за этого сходит с ума.
Изменено: Мария - - 3 сен 2020 17:24:28
VBA. Имя файла в каждой строке
 
Помогите, пожалуйста, исправить код.
Имеется 1 файл, в который из нескольких других файлов переносится информация. Нужно, чтобы напротив скопированной строки макрос прописывал имя файла, из которого он ее взял.
У меня по коду получается так, что макрос вписывает название только в 1ю строку из нового файла, а все остальные остаются пустыми до данных из следующего файла.

что не так?
Код
i = 2
Set dirObj = mergeObj.Getfolder("C:\Users\......")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

... часть макроса с копированием строк

Dim fileName As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fileName = fso.GetFilename(everyObj)


Workbooks("Quarter brandmap macro_test.xlsm").Sheets("copied").Range("AQ" & i).Value = fileName
Application.DisplayAlerts = False

bookList.Close
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
Next
Изменено: Мария - - 19 авг 2020 17:32:08
VBA. Слияние Excel и Word по шаблону
 
Уважаемые Знатоки! Помогите, пожалуйста подправить код:
1. Если в Word типлейте 2 раза указано поле для замены (например, &ContractNumber), оно не заполняется. Как заставить VBA заменить все встреченные, а не только 1е встреченное словосочетание.
2. Если файл с таким именем существует, VBA выдает ошибку. Можно ли файл просто заменить на новый с таким же именем?
Код
Sub FillInNotifNew()

Sheets("For Notif (new)").Select

Dim wdApp As Object
Dim wdDoc As Object

HomeDir$ = ThisWorkbook.Path

Set wdApp = CreateObject("Word.Application")
I% = 2

Do
If Cells(I%, 1).Value = "" Then Exit Do
If Cells(I%, 1).Value <> "no" Then

NPP$ = Cells(I%, 1).Text

' äëÿ çàïîëíåíèÿ óâåäîìëåíèÿ
CustomerNameFull$ = Cells(I%, 5).Text
ContractNumber$ = Cells(I%, 6).Text
ContractDate$ = Cells(I%, 7).Text
TermAgreemDate$ = Cells(I%, 8).Text
NotifDate$ = Cells(I%, 9).Text
Distributor$ = Cells(I%, 10).Text
Bonus$ = Cells(I%, 11).Text
Points$ = Cells(I%, 12).Text
AmountWritten$ = Cells(I%, 13).Text
POA$ = Cells(I%, 14).Text
BonPeriod$ = Cells(I%, 17).Text

' äëÿ íàçâàíèÿ ôàéëà
PeriodForFile$ = Cells(I%, 15).Text
ContractForFile$ = Cells(I%, 16).Text
CustomerForFile$ = Cells(I%, 4).Text

FileCopy HomeDir$ + "\template_new.docx", HomeDir$ + "\" + "Bonus Lease (" + ContractForFile$ + ") - " + CustomerForFile$ + "_ " + PeriodForFile$ + ".docx"
Set wdDoc = wdApp.Documents.Open(HomeDir$ + "\" + "Bonus Lease (" + ContractForFile$ + ") - " + CustomerForFile$ + "_ " + PeriodForFile$ + ".docx")

wdDoc.Range.Find.Execute FindText:="&CustomerNameFull", ReplaceWith:=CustomerNameFull$
wdDoc.Range.Find.Execute FindText:="&ContractNumber", ReplaceWith:=ContractNumber$
wdDoc.Range.Find.Execute FindText:="&ContractDate", ReplaceWith:=ContractDate$
wdDoc.Range.Find.Execute FindText:="&TermAgreemDate", ReplaceWith:=TermAgreemDate$
wdDoc.Range.Find.Execute FindText:="&NotifDate", ReplaceWith:=NotifDate$
wdDoc.Range.Find.Execute FindText:="&Distributor", ReplaceWith:=Distributor$
wdDoc.Range.Find.Execute FindText:="&Bonus", ReplaceWith:=Bonus$
wdDoc.Range.Find.Execute FindText:="&Points", ReplaceWith:=Points$
wdDoc.Range.Find.Execute FindText:="&AmountWritten", ReplaceWith:=AmountWritten$
wdDoc.Range.Find.Execute FindText:="&POA", ReplaceWith:=POA$
wdDoc.Range.Find.Execute FindText:="&BonPeriod", ReplaceWith:=BonPeriod$

wdDoc.Save
wdDoc.Close

End If

I% = I + 1
Loop

wdApp.Quit

MsgBox "Ãîòîâî!"

End Sub
VBA. Извлечение данных между символами
 
Доброго времени суток, Знатоки!
Очень нужна помощь в написании VBA кода.

Имеем Номер ГТД и Страну в разных форматах (колонка GTD Info), нужно информацию в одной колонке разделить на 3

например, имеем [10009190/190819/0003170/006]+[IT]
в колонке GTD No должно быть 10009190/190819/0003170/006
в колонке Country No (ISO) должно быть 380
в колонке Country Name должно быть Италия

во вложенном файле есть пример того, как должны быть заполнены колонки. а также на листе Country List - данные по странам, на основании которых должны заполняться колонки
я бы воспользовалась формулой SEARCH, но у меня возникает проблема, когда в одной строке несколько номеров и все они должны быть указаны
Изменено: Мария - - 5 фев 2020 16:42:34
VBA. Остановить макрос, если пустое значеие и запустить следующий
 
Уважаемые Знатоки! Очень нужна помощь. Есть 2 макроса YFRP_Data() и Invoice_Report(). Иногда случается так, что для продолжения работы YFRP_Data нет данных в листе Invoice_Header колонка F, иногда она заполнена частично.

Вопрос, как заставить макрос проверять: если колонка полностью пустая, то стоп макрос и старт следующий Invoice_Report()

Я написала такой код для проверки, но он явно не работает, потому что макрос все равно пытается продолжить работать.
Помогите, пожалуйста!
Код
    Dim LastRow As Long, i As Long
    LastRow = Cells(Rows.Count, "F:F").End(xlUp).Row
    For i = LastRow To 2 Step -1
    If Cells(i, "F:F") = "" Then End
    Next
Макрос. Массовая рассылка писем с таблицей в теле письма и вложением
 
Уважаемые Знатоки!
Долго и упорно копалась в интеренете и так и не смогла приладить к своему файлу макрос по написанию писем.

Итак задача:
на листе emails указаны имена менеджеров, email адреса и тема письма, которая должна генериться
В теле письма должен быть текст "Добрый день! во вложении отчет. Просьба обратить внимание на .. {таблица с листа с именем менеджера}. Подпись" + Вложенный файл
Путь к файлам заложен другим макросом
Код
 sPath = ThisWorkbook.Path & "\" & RepPeriod & "\"
.SaveAs sPath & "BDF Report_" & RepPeriod & "_" & Manager & ".xlsx"
Таблицы по каждому менеджеру разносятся на отдельные листы. Имена всегда уникальны.

Помогите, пожалуйста!  :cry:  Бьюсь 2й день!
Макрос. Разбивка листа на несколько по имени менеджера
 
Добрый день! опять я с вопросом, который не смогла победить сама.
Во вложении файлик с примером общей таблицы по договорам. Мне нужно, чтобы при нажатии кнопки, Excel создавал по имени менеджера отдельный лист с данными из общей страницы в этой же книге. Все завязано на имени менеджера и название листов в том числе.
Шапка (2 первые строки) также должна копироваться на каждый лист.
Так же крайне желательно, чтобы при повторном нажатии на кнопку "макроса" предыдущие данные с листа Менеджера стирались.
Изменено: Мария - - 15 май 2019 17:20:40
Макрос. Разбивка Excel файла на разные файлы в зависимости от менеджера.в
 
Добрый день! Помогите, пожалуйста, написать макрос, который бы разбил Excel файл по менеджерам.
В файле примере есть лист Contracts (все контракты+менеджер+stl) и листы с данными по договорам. Также на листе Contracts есть колонка Sheet name, которая соответствует названию листа с договором.

Нужно разбить так, чтобы все литы с договорами разбились по отдельным файлам в зависимости от менеджера, т.е. 1 менеджер = 1 файл = несколько листов.
При этом, чтобы листы копировались как Value+Format (без формул).
Макрос. Копирование данных в лист другого файла с изменяющимся названием
 
Помогите, пожалуйста. Не могу справиться с кодом

Название листа зависит от содержимого ячейки: Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Value
Копировать нужно с 2й строки Workbooks("Book1.xlsm").Sheets("Invoices") - в момент копирования макрос находится именно на этом листе
Попробовала так
Код
Sub Copy_Data()

    Dim bk_src As Workbook, bk_res As Workbook, sh_res As Worksheet
    Set bk_src = Workbooks("Book1.xlsm")
    Set bk_res = Workbooks("Book2.xlsm")
    sh_res.Name = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Value
    sh_src.UsedRange.Offset(1, 0).Copy sh_res.[A1].End(xlDown)(2)
    
MsgBox ("INCOICES DOWNLIADING - Compleat!")

End Sub

Макрос выдает ошибку именно на :
Код
sh_res.Name = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Value
Макрос. Проверка столбца на наличие ошибки и остановка макроса
 
Помогите, пожалуйста. Макрос делает проверку на наличие ошибки в определенном столбце. После этого действия есть продолжение макроса.
Мне нужно, чтобы макрос прекращал полностью работу и выдавал сообщение об ошибке.
С проверкой и ошибкой проблем нет, а вот с одновременной остановкой и сообщением - проблема :(
Как допилить код?
Код
Sub Check()

    Dim LastRow As Long, i As Long
    LastRow = Cells(Rows.Count, 13).End(xlUp).Row
    For i = LastRow To 2 Step -1
    If Cells(i, 13) = "error" Then MsgBox "!!! #N/A in ServRendDate !!!"
    Range("M1").Select
    Next
End Sub
Макрос. Создание нового листа в другом файле, копирование данных из 1го файла
 
Помогите, пожалуйста, поправить макрос, чтобы он работал.
Нужно создать новый лист, присвоить имя (оно меняется и берется из определенной ячейки в файле), после этого перенести данный лист в другой файл.
Данные нужно скопировать полностью.

Не могу объединить макрос копирования и создания нового листа в другом файле. У меня проблема с тем, что имя листа каждый раз меняется :(
Код
Sub AddCopy()

    Windows("Book1").Activate
    Sheets("Invoices").Select
    Cells.Select
    Selection.Copy
    Windows("Book2.xlsm").Activate
    
    Sheets.Add(Before:=Worksheets("Sold-to for report")).Name = Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("E5")
    
    Sheets(Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("E5")).Select
    Cells.Select
    ActiveSheet.Paste
    Windows("Book1.xlsm").Activate
    Sheets("Sheet1").Select
    Range("A1").Select

End Sub
Изменено: Мария - - 9 май 2019 18:50:01
Макрос. Копирование данных из одного листа в конец другого
 
Помогите, пожалуйста! Я начинающий пользовалель макросами с данной задачей справиться не могу.
Задача. Скопировать данные из Sheet2 (начиная с 2й строки) в под данные в Sheet1. Количество строк меняется на каждом из листров.
Я попробавала такое вариант:
Код
Sub Macro2()
Sheets("Sheet2").[A1].CurrentRegion.Offset(1).Copy Sheets("Sheet1").[A1].End(xlDown)(2)
End Sub

Но столкнулась с проблемой. На листе Sheet2 есть пустые колонки. Макрос копирует данные до первой пустой колонки, а нужно копировать всю строку
Изменено: Мария - - 8 май 2019 21:30:07
Макрос. Подставить формулу VLOOKUP с переменчивым количеством строк
 
Помогите, пожалуйста.
Мне нужно написать часть макроса, которая бы подставляла формулу VLOOKUP (ВПР) с одного листа файла в другой.
Я застраяла на том, что количество строк переменчиво на листе, куда подставляем формулу.

В файле 2 страницы. На Sheet2 по Invoice No. с листа Sheet1 подставить дату из колонки D.  
Макрос. Если ячека = значение, Удалить строку
 
Помогите, пожалуйста!
Мне нужен макрос, который будет по значению в колонке В удалять полностью строку. Главное условие, что значения В (примерно 15 разных), могут в данном конктретном списке отсутвовать.
Например, во вложенном файле таблица. В колонке "В - Document Type" некие значения. Нужно проверить удалить строки, в которых в колонке В есть значение ZF8, ZB3G или ZF5. Последние значение как раз отсутствует в списке.
Подставить к продаже номер договора при условии, что у клиента может быть несколько договоров в списке
 
Помогите, пожалуйста, не могу сообразить. Есть 2 списка: список договоров (с кодом клиента и сроком действия), список продаж (с кодом клиента и датой продажи). Нужно подставить к продаже номер договора при условии, что у клиента может быть несколько договоров в списке, но с разными сроками действия.
Рассчет суммы с двумя условиями в промежутке времени
 
Уважаемые Знатоки Excel!
Очент нужна помощь в прописании формулы для расчета.

Есть данные - сф, коды продуктов, литры, даты, коды клиентов
Нужно рассчитать, сколько клиент купил литров по каждому продукту за определенный срок времени.

В загруженном файле пример.
Пожалуйста, помогите чайнику!
Страницы: 1
Наверх