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

Страницы: 1 2 След.
Определить лучшие по разнице в марже объемы отгрузок
 
#
07.05.2021 11:59:38
Добрый день.
В отчете есть необходимость определить сколько и какие варианты отгрузок оставить в зависимости от ограничения по объему.

Дело в том, что если оставить за своим предприятием объемы лучшие по марже, доходность выходит меньше, чем, если оставить объемы, лучшие по разнице в марже между своим предприятием и предприятиями, у которых можно дополнительно закупить эту же продукцию.

Для сравнимости я выставил одинаковые объемы.

Проблема в том, что простое суммирование не помогает, если менять сортировку.
Можно ли как то реализоваться формулой (ну, или макросом), которая выделит без сортировки лучшие по разнице в марже объемы приблизительно на общий объем ограничения (в данном случае 50 000 тн для модели или 20000 тн, если брать реальные объемы из столбца В?
 
Перейти    
Выбор всех значений из списка по условию при помощи макроса, а не формулы, многоразовый ВПР
 
#
01.05.2021 20:27:26
Добрый день.
В отчетном файле есть необходимость забирать из списка размером более 10 000 строк данные о станциях по условию выбора из выпадающего списка предприятия.
На данный момент это происходит при помощи формулы массива. Как вы понимаете, с быстродействием все очень грустно, при том, что сам файл заточен на кучу задач.
Есть ли возможность вытащить необходимую информацию на другой лист макросом? И как вариант, вытащить не все станции, а только станции с не пустыми значениями больше ноля?
 
Перейти    
Оптимизация распределения объемов. Вероятно, лучше макросом.
 
#
08.03.2021 18:47:04
Добрый день.
На работе подкинули задачу оптимального распределения объемов отгрузки.
Я сделал формулой, но, поскольку формула перебирает 12 000 строк, ждать, когда она закончит пересчитывать любое изменение, это за гранью добра и зла.
Пытался прикрутить поиск решения, но он имеет ограничение, а у меня точек доставки более 300.

Кто возьмется предложить делать это упражнение макросом, чтобы модель, хотя бы при любом изменении параметров не начинала пересчитываться и виснуть.

С уважением,
Олег
 
Перейти    
Подсчет количества уникальных записей в 4 столбцах
 
#
11.11.2019 12:08:34
Добрый день.
Как подсчитать количество уникальных записей в одном столбце, это понятно.

А, есть варианты, как подсчитать количество уникальных записей, одновременно в четырех столбцах?

С уважением,
Олег
 
Перейти    
Выделение из пофамильного списка значения в алфавитном порядке по двум условиям
 
#
10.11.2019 14:19:15
Добрый день.
Помогите, пожалуйста со сложносочиненной формулой.
Есть таблица данных со списком ФИО сотрудников по вертикале и номерами процессов, в которых они участвуют, по горизонтали. Нужно формулой перенести на другой лист в алфавитном порядке сотрудников по условию участия в процессах (до 4 возможных одновременно). Сотрудник может участвовать в одном, а может в четырех процессах, но в список они должны попасть один.

Файл с примером во вложении.
Если я некорректно объяснил, напишите.

Заранее спасибо.
С уважением,
Олег
 
Перейти    
Перенос информации из нескольких документов Word в один, оптимизация макроса
 
#
08.11.2019 09:58:15
Добрый день.

Знающие люди, помогите, пожалуйста, оптимизировать код в макросе. Сам то я ни разу не программист ))
Что смог, я в макросе собрал. Он рабочий. Но есть проблема, которая (надеюсь, пока) выше моего разумения.

Засунуть все повторяющиеся действия с открытием файлов Word и копированием данных в шаблон в цикл, который будет проверять наличие в папке файла с соответствующим ячейке названием и если его нет, переходить к следующей ячейке.

Сам файл тяжелый да еще и связан с текстовыми файлами, поэтому вкладываю, только, код.
Заранее спасибо.
Код
Sub Кнопка1_Щелчок()    Dim ICell As Range, FR As Long, Kriteriy As String
    Dim objWrdApp As Object
    Dim objWrdDoc As Object
    Dim objWrdDoc1 As Object
    
    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Set objWrdApp = CreateObject("Word.Application")
        Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\РИ\Шаблон_Ролевая_Инструкция_пользователя.docx")
            objWrdApp.Visible = True
    End If
    Application.ScreenUpdating = False
    Kriteriy = Range("D1")
    Sheets(6).Cells.Clear
    Range(Cells(2, 3), Cells(2, 5)).Copy Sheets(6).Cells(1, 1)
    Cells(2, 9).Copy Sheets(6).Cells(1, 4)
    FR = 2
    For Each ICell In Range(Cells(3, "J"), Cells(Rows.Count, "J").End(xlUp))
       If ICell Like Kriteriy & "*" Then
          Range(Cells(ICell.Row, 3), Cells(ICell.Row, 5)).Copy
          Sheets(6).Cells(FR, 1).PasteSpecial Paste:=xlPasteValues
          Sheets(6).Cells(FR, 1).PasteSpecial Paste:=xlPasteFormats
          Range(Cells(ICell.Row, 9), Cells(ICell.Row, 10)).Copy
          Sheets(6).Cells(FR, 4).PasteSpecial Paste:=xlPasteValues
          Sheets(6).Cells(FR, 4).PasteSpecial Paste:=xlPasteFormats
          FR = FR + 1
       End If
    Next
 
    Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\РИ\Шаблон_Ролевая_Инструкция_пользователя.docx")
        objWrdDoc.Bookmarks("БизнесРоль").Range.InsertAfter (Cells(1, 4).Value)
        objWrdDoc.Bookmarks("БизнесРоль1").Range.InsertAfter (Cells(1, 4).Value)
        
        objWrdDoc.Bookmarks("ТранзАк1").Range.InsertAfter (Sheets(4).Cells(25, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(25, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк1текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк2").Range.InsertAfter (Sheets(4).Cells(26, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(26, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк2текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк3").Range.InsertAfter (Sheets(4).Cells(27, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(27, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк3текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк4").Range.InsertAfter (Sheets(4).Cells(28, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(28, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк4текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк5").Range.InsertAfter (Sheets(4).Cells(29, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(29, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк5текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк6").Range.InsertAfter (Sheets(4).Cells(30, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(30, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк6текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк7").Range.InsertAfter (Sheets(4).Cells(31, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(31, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк7текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк8").Range.InsertAfter (Sheets(4).Cells(32, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(32, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк8текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк9").Range.InsertAfter (Sheets(4).Cells(33, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(33, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк9текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк10").Range.InsertAfter (Sheets(4).Cells(34, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(34, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк10текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк11").Range.InsertAfter (Sheets(4).Cells(35, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(35, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк11текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк12").Range.InsertAfter (Sheets(4).Cells(36, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(36, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк12текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк13").Range.InsertAfter (Sheets(4).Cells(37, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(37, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк13текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк14").Range.InsertAfter (Sheets(4).Cells(38, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(38, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк14текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк15").Range.InsertAfter (Sheets(4).Cells(39, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(39, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк15текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк16").Range.InsertAfter (Sheets(4).Cells(40, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(40, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк16текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк17").Range.InsertAfter (Sheets(4).Cells(41, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(41, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк17текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк18").Range.InsertAfter (Sheets(4).Cells(42, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(42, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк18текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк19").Range.InsertAfter (Sheets(4).Cells(43, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(43, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк19текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк20").Range.InsertAfter (Sheets(4).Cells(44, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(44, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк20текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк21").Range.InsertAfter (Sheets(4).Cells(45, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(45, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк21текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк22").Range.InsertAfter (Sheets(4).Cells(46, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(46, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк22текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк23").Range.InsertAfter (Sheets(4).Cells(47, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(47, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк23текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк24").Range.InsertAfter (Sheets(4).Cells(48, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(48, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк24текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        objWrdDoc.Bookmarks("ТранзАк25").Range.InsertAfter (Sheets(4).Cells(49, 4).Value)
    Set objWrdDoc1 = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Транзакции\" + Sheets(4).Cells(49, 4).Value + ".docx")
        objWrdDoc1.Range(Start:=objWrdDoc1.Bookmarks("ТранзАкТекстНачало").Start, End:=objWrdDoc1.Bookmarks("ТранзАкТекстКонец").Start - 1).Copy
        objWrdDoc.Bookmarks("ТранзАк25текст").Range.PasteAndFormat (wdFormatOriginalFormatting)
        objWrdDoc1.Close SaveChanges:=False
        
        Sheets(6).Range("A1:D" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
        objWrdDoc.Bookmarks("Бизнес_функции_Роли").Range.PasteAndFormat (wdFormatOriginalFormatting)
        
        Const wdHeaderFooterPrimary = 1
        For Each objSection In objWrdDoc.Sections
        If objSection.Index > 1 Then objSection.Headers(wdHeaderFooterPrimary).Range.Cells(1).Range.Text = "Инструкция пользователя " + Range("D1")
        Next
  
        objWrdDoc.TablesOfContents(1).Update
        objWrdDoc.SaveAs (ThisWorkbook.Path & "\РИ\173_1.2.1.2.0-XX_" + Range("D1") + "_" + Format(Date, "dd/mm/yyyy") + ".docx")
        Application.ScreenUpdating = True
        Application.CutCopyMode = False
        
    Set objWrdDoc = Nothing
   'Set objWrdDoc1 = Nothing
    Set objWrdApp = Nothing
    
End Sub
С уважением,
Олег
 
Перейти    
Запрет на ввод информации в ячейку по условию
 
#
10.09.2019 10:59:09
Добрый день.

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

С уважением,
Олег
 
Перейти    
Выбор из выпадающего списка через фильтрацию позиций макросом
 
#
09.09.2019 15:50:27
Добрый день.

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

С уважением,
Олег
 
Перейти    
Определение номера позиции в динамической таблице
 
#
09.09.2019 13:28:13
Добрый день. Можно ли, каким-то образом изощриться и организовать присвоение позиции строки с шагом 10 (10; 20; 30 и т.д.)
Проблема в том, что иерархию и количество позиций формируют произвольно выпадающим списком в столбце А. Во вложенном файле пример, как должны быть присвоены номера, в зависимости от представленной иерархии.

С уважением,
Олег
 
Перейти    
Замена текста в ячейке таблицы в колонтитуле документа ворд значением из ячейки эксель макросом из эксель
 
#
06.09.2019 12:04:21

Добрый день.
Название темы, немного, длинное, но отражает суть проблемы.
На просторах интернета достаточно информации как обратиться к верхнему не первому колонтитулу документа ворд из эксель. Но как я не пытался, у меня не получается добавить замену именно теста в ячейке таблицы в колонтитуле. Таблица в колонтитуле документа ворд состоит из одной строки и двух столбцов. Вот в первом столбце я пытаюсь добавить в текст "Инструкция пользователя """ наименование из ячейки активного листа эксель (допустим A1). Подскажите, что нужно добавить в приведенный ниже код.

Код
Sub Кнопка1_Щелчок()    Dim objWrdApp As Object
    Dim objWrdDoc As Object
    
    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Set objWrdApp = CreateObject("Word.Application")
        Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Шаблон_инструкция пользователя.docx")
        objWrdApp.Visible = True
    End If
    
    
    Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\Шаблон_инструкция пользователя.docx")
        objWrdDoc.Bookmarks("БизнесРоль").Range.InsertAfter (Cells(1, 4).Value)
        objWrdDoc.Bookmarks("БизнесРоль1").Range.InsertAfter (Cells(1, 4).Value)
                
        objWrdDoc.ActiveWindow.ActivePane.View.SeekView = 9 'Открываем непервый верхний колонтитул
        With objWordApp.Selection
                    .Text = "Инструкция пользователя """
                    .Replacement.Text = "Инструкция пользователя Куратор договора"
                    .Forward = True
                    .Wrap = 1
                    .Format = False: .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                    .Execute Replace:=2
        End With
        objWrdDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 'Закрываем колонтитул                  
           
        objWrdDoc.SaveAs (ThisWorkbook.Path & "\173_1.2.1.2.0-XX_" + Range("D1") + "_" + Format(Date, "dd/mm/yyyy") + ".docx")
        
        Application.CutCopyMode = False
        
    Set objWrdDoc = Nothing
    Set objWrdApp = Nothing
    
End Sub



С уважением,
Олег
 
Перейти    
Выбор строк таблицы по условию пятого столбца.
 
#
03.09.2019 11:59:51
Добрый день.
Появилась вот такая задача.
В файле есть таблица с изменяемым количеством строк. Необходимо макросом скопировать шапку, четыре столбца и часть строк как таблицу в другой файл (любой) по условию пятого столбца. Условие выбирается в выпадающем списке выше таблицы.
На простое копирование части таблицы как диапазона у меня мозгов хватает. А на большее - неа. ))
Формат при копировании должен сохраниться.

С уважением,
Олег
Изменено: grand68 - 03.09.2019 12:01:06
 
Перейти    
Суммирование заранее неизвестного количества ячеек в диапазоне формулой
 
#
30.08.2019 10:50:01
Добрый день.
Возможно, криво назвал тему, но суть в следующем.

Есть столбец позиций. Количество подпозиций для конкретной позиции в соседнем столбце неизвестно. Может быть 0, а, может, и 100.
Есть ли Вариант суммирования этих подпозиций или придется таблицу перекраивать?

С уважением,
Олег.
 
Перейти    
Фильтрация списка по любой части текста макросом
 
#
28.08.2019 13:46:49
Добрый день.
Во вложении файл, который делает фильтрацию списка по первой букве.
А, можно, ли добавить в код макроса условие (со звездочкой, например), чтобы фильтрация начиналась по любой части текста.
В списке примера есть слово "сейсморазведочные".
В приложенном варианте, если набирать с буквы "с", позиции, имеющие слово "сейсморазведочные" в середине текстовой строки, не выцепляются.

С уважением,
Олег
 
Перейти    
Изменение ширины элемента ActiveX textbox вместе с изменением ширины столбца
 
#
27.08.2019 14:29:03
Добрый день.
Если вопрос глупый/простой/сам мог найти ответ, прошу не пинать. ))

Можно ли заставить элемент ActiveX textbox менять ширину вместе с изменением ширины столбца ячейки, где он размещен?

С уважением,
Олег.
 
Перейти    
Присвоение уникального номера ячейке в добавляемой строке макросом
 
#
22.08.2019 11:39:53
Добрый день. Приведенный ниже макрос добавляет пустые строки в таблицу в загруженном файле по нажатию кнопки.
К сожалению, рабочий файл не удалось, даже, архивированием ужать до 100 кб.
Поэтому, файл приложил отдельно, код для кнопки вставил в сообщение отдельно.
Закавыка в том, что необходимо присваивать вновь добавленным строкам не порядковый номер в столбце "B", а первый свободный пустой номер, а если таких нет, первый номер после максимального имеющегося. Строки могут добавляться в любом месте таблицы. То, есть, встав, например, между номерами 5 и 6 строке должен быть присвоен номер 13. А если, перед этим удалят строки с номерами 7 и 9, то следующей добавленной строке должен быть присвоен номер 7, добавленной за ней - номер 9 а добавленной за ними, уже, номер 13.
Можно ли добавить реализацию такого условия в макрос добавления строки по шелчку кнопки, приведенному ниже?

С уважением,
Олег
Код
Sub Кнопка4_Щелчок()
    Application.ScreenUpdating = False
    If Application.Intersect(ActiveCell, ActiveSheet.UsedRange) Is Nothing _
        Or ActiveCell.Row < 9 Then
            MsgBox "Активная строка вне таблицы"
    Else
        Rows(ActiveCell.Row).Insert
        Rows(ActiveCell.Row + 1).Copy Rows(ActiveCell.Row)
    End If
       Cells(ActiveCell.Row + 1, 3).Resize(, 7).Value = Empty
       Cells(ActiveCell.Row + 1, 11).Resize(, 3).Value = Empty
       Cells(ActiveCell.Row + 1, 15).Resize(, 8).Value = Empty
       Range(Cells(ActiveCell.Row + 1, 4), Cells(ActiveCell.Row + 1, 9)).Locked = False
       Cells(ActiveCell.Row + 1, 22).Locked = False
    Application.ScreenUpdating = True
End Sub
 
Перейти    
Изменить формулой формат представления иерархии элементов в таблице
 
#
14.08.2019 11:34:53
Добрый день.

Существует представление иерархии в виде:
1.
1.1.
1.1.1.
и т.д.  
Уровней иерархии 6. Последний уровень может иметь до 999 элементов

Можно ли формулой изменить представление иерархии в вид:
01.00.00.00.00.000
01.01.00.00.00.000
01.01.01.00.00.000
и т.д. до
01.01.01.01.01.001

Пример во вложении.
Заранее, спасибо.
С уважением,
Олег.
 
Перейти    
Оптимизация формулы фильтрации значений из таблицы более 1000 строк
 
#
09.08.2019 12:38:15
Добрый день.
В ежедневной отчетности имеется таблица, в которой необходимо проставлять код и наименование услуги. Но справочник услуг состоит из более чем 1000 позиций и находится на другом листе (иногда и другом файле). Делать в таблице выпадающий список с тысячей элементов - не самый желаемый вариант. Я решил попробовать прикрутить формулу фильтрации элементов. Но, применяемая формула может только опознать введенный в таблицу код, как наименьший и выгрузить в служебный (рабочий) столбец все коды и услуги больше вводимой. Задача, которую хотелось бы решить, чтобы в массив значений в служебный столбец выгружались формулой массива коды имеющие в своем составе цифры кода из таблицы.

Например:
Вводим 03 - выгружаются все позиции с кодами, где первые цифры 03
Вводим 0301 - выгружаются все позиции с кодами, где первые цифры 0301
и так далее...

Максимально возможный код приведен в файле. Есть вариант с разделением групп кодов точками, есть вариант без точек.
Можно ли как-то решить эту задачу, модифицировав формулу массива в файле или заменив какой то другой?

С уважением,
Олег.
 
Перейти    
Запрет на удаление строк любым способом, в том числе макрокомандами
 
#
08.08.2019 11:34:03
Добрый день.
Рискну создать еще одну тему.
Благодаря помощи форума прикрутил к кнопке макрос добавления строк.
Рядом на форме живет кнопка с макросом удаления строк. Она предусмотрена для удаления вновь добавленных строк, но, с удовольствием удаляет любую, уже имеющуюся строку таблицы.
Можно ли в код макроса удаления строк дописать команду запрета удаления любой строки в 22 столбце которой стоит слово "запрет"
Код
Sub Кнопка5_Щелчок()
    Application.ScreenUpdating = False
    If Application.Intersect(ActiveCell, ActiveSheet.UsedRange) Is Nothing _
        Or ActiveCell.Row < 9 Then
            MsgBox "Активная строка вне таблицы"
    Else
        Rows(ActiveCell.Row).Delete
    End If
    Application.ScreenUpdating = True
End Sub
 
Перейти    
Сохранение форматов, формул и пересчет порядковых номеров строк таблицы при добавлении новой строки макросом
 
#
07.08.2019 14:23:08

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

Код
Sub Кнопка4_Щелчок()
    Application.ScreenUpdating = False
    If Application.Intersect(ActiveCell, ActiveSheet.UsedRange) Is Nothing _
        Or ActiveCell.Row < 10 Then
            MsgBox "Активная строка вне таблицы"
    Else
        Rows(ActiveCell.Row).Insert
        Rows(ActiveCell.Row + 1).Copy Rows(ActiveCell.Row)
    End If
       Rows(ActiveCell.Row + 1).ClearContents
       Application.ScreenUpdating = True
 End Sub

Код
Sub Кнопка5_Щелчок()
    Application.ScreenUpdating = False
    If Application.Intersect(ActiveCell, ActiveSheet.UsedRange) Is Nothing _
        Or ActiveCell.Row < 10 Then
            MsgBox "Активная строка вне таблицы"
    Else
        Rows(ActiveCell.Row).Delete
    End If
    Application.ScreenUpdating = True
 End Sub

Проблема в том, что, при добавлении строка зачищается целиком, а, нужно сохранить форматы, а в определенных столбцах и формулы. Кроме того, пересчитать порядковые номера в столбце B.

Соответственно, при удалении строки, так же, пересчитать порядковые номера и формулы.

Помогите, пожалуйста, дописать код.

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

С уважением,

Олег
 
Перейти    
Сумирование, если и данные и условие суммирования расположены в одной строке
 
#
27.12.2017 12:52:20
Добрый день. Подскажите, пожалуйста, как формулой суммировать если и данные для суммирования и условия суммирования расположены в одной строке.
Пример во вложении.
 
Перейти    
Вычесть значение из первого ненулевого в строке
 
#
21.12.2017 12:59:18
Добрый день.
Как можно вывернуться и вычесть заданное значение (в файле в зеленой клетке) из первого ненулевого? Формулу поиска первого ненулевого я нашел, но проблема в том, что в строке и первое и второе значение могут быть одинаковыми.
Изменено: grand68 - 21.12.2017 13:06:10 (Ошибка в названии темы)
 
Перейти    
Распределение входящих данных по плавающему условию
 
#
14.12.2017 13:02:00
Добрый день.
При подготовке шаблона для планирования столкнулся с проблемой, которую не могу объехать.

В качестве входящих данных есть
1) нормативные объемы работы в конкретную дату (либо 0, если производство стоит, либо 81, если работает)
2) объем работы в конкретную дату (380; 482), которые нужно распределить пропорционально пункту 1 в даты, предшествующие событию 380 или 482.

Проблема в том, что даты, когда есть 0 или 81 могут меняться, как и даты, когда происходит событие 380 или 482.
Нужна какая-то универсальная формула. Я делал формулу с вложением условий, получается 20-этажная, так как возможных дат для событий шесть.

Пример во вложении. Входящие данные синим. То, что должно получиться - зеленым.
 
Перейти    
Распределение входящих данных по плавающему условию
 
#
14.12.2017 10:59:30
Добрый день.
При подготовке шаблона для планирования столкнулся с проблемой, которую не могу объехать.

В качестве входящих данных есть
1) нормативные объемы работы в конкретную дату (либо 0, если производство стоит, либо 81, если работает)
2) объем работы в конкретную дату (380; 482), которые нужно распределить пропорционально пункту 1 в даты, предшествующие событию 380 или 482.

Проблема в том, что даты, когда есть 0 или 81 могут меняться, как и даты, когда происходит событие 380 или 482.
Нужна какая-то универсальная формула. Я делал формулу с вложением условий, получается 20-этажная, так как возможных дат для событий шесть.
Если у кого-то есть мысли, буду очень признателен ))
Пример во вложении. Входящие данные синим. То, что должно получиться - зеленым.

С уважением, Олег.
 
Перейти    
Выйти формулой на результат работы каждой единицы техники
 
#
29.09.2017 16:06:22
Добрый день.
Вот, задачку на работе подкинули, на калькуляторе я ее решаю, а, хотелось бы универсальной формулой. ))

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

В принципе, это можно реализовать формулой или нет?
 
Перейти    
Распределение общего количества часов на несколько дней в зависимости от даты начала и конца
 
#
31.08.2017 06:20:57
Добрый день. Подскажите, возможно ли универсальной формулой зацепить и уникальное действие и его длительность и распределить по датам в другой таблице, в зависимости от даты начала и количества часов. Пример во вложении. Если путанно объяснил суть проблемы, подскажите, каких входящих данный не хватает.
Спасибо.
 
Перейти    
Выбор всех определенных значений из диапазона
 
#
15.05.2017 11:10:19
Добрый день. Подскажите, если ли возможность при  помощи формул вытащить из диапазона все значения одного наименования (например: март) и перенести в другой диапазон? В приложенном файле из серого диапазона вытащить в светло-желтый.
 
Перейти    
Очистка данных в диапазоне игнорируя защищённые ячейки
 
#
27.10.2016 14:15:53
Еще раз, добрый день.
Код
Private Sub CommandButton1_Click()
         
    Range("G20:T27,G29:H38,G40:H49").Select
    Selection.ClearContents
 
End Sub
Этот макрос зачищает выделенные маленькие диапазоны. А если таких диапазонов сотни?

Можно ли исхитриться и, задав сразу диапазон всей таблицы (условно G20:AA49) очистить только незащищённые ячейки в этом диапазоне?
 
Перейти    
Защита кнопки (элемента ActiveX) паролем от случайного нажатия
 
#
27.10.2016 13:36:18
Добрый день. Что-то меня заклинило. Можно ли защитить кнопку на листе от случайного нажатия паролем? В архивах форума покопался, что-то не нашел ответ.
 
Перейти    
Подсчет часов в течение суток без повтора
 
#
17.10.2016 12:33:54
Добрый день. Кривовато, конечно, назвал тему. Суть вот в чём. Сутки на предприятии длятся с 8-00 одной даты по 8-00 другой даты.
В течение этого времени предприятия по той или иной причине останавливается. Ведется учёт причин и количества времени простоя. Но, суммировать количество часов простоя по той или иной причине не получается, так как на разном оборудовании эти часы друг друга перекрывают, а нужно сосчитать только часы, повлиявшие на остановку предприятия в целом. Во вложенном файле зеленым цветом указано корректное количество часов простоя, фиолетовым сумма часов по строкам. Можно ли как-то выкрутиться из этой ситуации с помощью формулы?
С уважением, Олег.
 
Перейти    
Вычисление процента отходов в зависимости от изменения состава и процента выхода готовой продукции
 
#
12.01.2016 11:13:12
Добрый день.
Можно ли как-то упростить формулу в ячейке B28 во вложенном файле?
 
Перейти    
Страницы: 1 2 След.
Наверх