Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » max_2311
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Макрос сбора данных из нескольких листов и вставка в один общий лист, Прайс-лист из нескольких листов в книге.
 
#
21.02.2015 21:54:06
Прошу оказать содействие в написании Макроса для сбора данных на Лист “Результат” в формате "Таблица с заголовками". Диапазон собираемых данных A2:J~  с Листов указанных в Листе “Справочник листов”, а дальше со столбца K2:R~ работают формулы, которые я написал. Файл пример во вложении

На Листе “Результаты” приведен пример. Желтая полоса – данные с листов указанные в Листе “Справочник лисов”, Диапазон A2:J97.
На Листе “Акции” заносятся позиции по которым периодически проводятся акции с указанием интервала времени. Если товар участвует в акции то в столбец K2:K~ подставляется по формуле ИНДЕКС(ПОИСКПОЗ( ……
На Листе “Курсы валют” заносятся курсы валют, которые меняются с определенным интервалом, для примера смена каждую неделю.
В столбец L2:L~ Лист “Результат” подставляется значение текущего курса по формуле ИНДЕКС(ПОИСКПОЗ( ……
Аналогичное происходит с Листом “Скидки” и Столбцами N2:N~ и P2:P~
Изменено: max_2311 - 21.02.2015 22:43:35
 
Перейти    
Выпадающий список с добавлением новых данных в определенные справочники,
 
#
14.11.2014 22:39:35
Добрый вечер.

Прошу помощи у знатоков Excel.
Во вложении файл "Сервисный журнал", в котором ведется учет Клиентов, Тип машин, Моделей машин и т.д.
При занесении данных во вкладку Учет, если значение есть в Справочнике, то значение из списка, если нет - добавляется в нужный справочник.
Но это работает только при коде на два столбца. Если код расширить до двух (и т.д.) то возникает ошибка "Block if without end if".

Прошу оказать содействие.
Всем хороших выходных.



Код
 Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim lReply As Long
 
   If Target.Cells.Count > 1 Then Exit Sub
     If Not Intersect(Target, Range("Учет.Тип")) Is Nothing Then
      If IsEmpty(Target) Then Exit Sub
          If WorksheetFunction.CountIf(Sheets("Справочник.Тип").Range("Справочник.Тип"), Target) = 0 Then
           lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список - Справочник. Тип?", vbYesNo + vbQuestion)
            If lReply = vbYes Then
                Sheets("Справочник.Тип").Range("Справочник.Тип").Cells(Sheets("Справочник.Тип").Range("Справочник.Тип").Rows.Count + 1, 1) = Target
            End If
          End If
      Else
      If Not Intersect(Target, Range("Учет.Бренд")) Is Nothing Then
      If IsEmpty(Target) Then Exit Sub
          If WorksheetFunction.CountIf(Sheets("Справочник.Бренд").Range("Справочник.Бренд"), Target) = 0 Then
           lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список - Справочник. Бренд?", vbYesNo + vbQuestion)
            If lReply = vbYes Then
                Sheets("Справочник.Бренд").Range("Справочник.Бренд").Cells(Sheets("Справочник.Бренд").Range("Справочник.Бренд").Rows.Count + 1, 1) = Target
             End If
          End If
      Else
      If Not Intersect(Target, Range("Учет.Модель")) Is Nothing Then
      If IsEmpty(Target) Then Exit Sub
          If WorksheetFunction.CountIf(Sheets("Справочник.Модель").Range("Справочник.Модель"), Target) = 0 Then
           lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список - Справочник. Модель?", vbYesNo + vbQuestion)
            If lReply = vbYes Then
                Sheets("Справочник.Модель").Range("Справочник.Модель").Cells(Sheets("Справочник.Модель").Range("Справочник.Модель").Rows.Count + 1, 1) = Target
            End If
          End If
End Sub
 
Перейти    
Поиск значения из предложения в ячейки по параметрам описанным в коде и вывод значений в новую ячейку
 
#
03.05.2014 23:26:22
Добрый вечер.
Есть необходимость проанализировать таблицу с данными импорта в диапазоне A1:BU25000 (диапазон меняется вниз).
Но столкнулся с тем, что данные по машинам (модель, грузоподъемность, высота мачты и т.д.) находятся в одной ячейке, это приводит к невозможности создания сводной таблицы для анализа.
Как из общего предложения в ячейки выделить в отдельные ячейки значения и данные следующими за ними? (данные разделены знаком, что облегчает поиск).
Значения для поиска (для кода)
Модель
Грузоподъемность
Мачта
и т.д. список исковых значений может меняться.

Если задача для Вас не сложная прошу оказать содействие в написании кода.
Вариантов написания у меня нет.
Изменено: max_2311 - 04.05.2014 12:40:03
 
Перейти    
Отправка книги или листа по электронной почте, Отправка файла вложением через Outlook
 
#
10.04.2014 16:46:28
Добрый день.
Не могу написать макрос для отправки документа вложением через Outlook.
Все сделал по примеру Универсального макроса №3 (http://www.planetaexcel.ru/techniques/13/48/), но вложение прикрепить не получается, так как в примере описывается процедура прикрепления файла по месту хранения, а мне нужно отправлять активную книгу.
Где допускаю ошибку?
Код
Sub SendMail()
    ActiveWorkbook.SendMail
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range     
     
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application" ;)    'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon
    On Error GoTo cleanup  'если не запустился - выходим
    Set OutMail = OutApp.CreateItem(0)  'создаем новое сообщение
    On Error Resume Next
    'заполняем поля сообщения
    With OutMail
     .To = Range("G7" ;) .Value
     .Subject = Range("A5" ;) .Value
     .Body = "Добрый день. Прошу рассмотреть запрос на скидку. Паспорт сделки во вложении."
     'команду Send можно заменить на Display, чтобы посмотреть сообщение перед отправкой
     .Display 
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
;
 
Перейти    
Страницы: 1
Наверх