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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 179 След.
Как переименовать файл, если найден текст
 
Наверное «СОЗДАТЕЛЬ» хочет чтобы в его макросе покапашились и сами пришли к нужному )
Заполнение файла с помощью данных из других книг Excel
 
Arina Sh, Ну вы сначала макросом проверьте или вы его в упор не видите?
для последнего примера...
запускаете файлы из архива ставите любой символ напротив фио для которого необходимо создать лист оценки и нажимаете кнопку.
Код
Sub pattern()
Dim SPISOK As Workbook, LO As Workbook, KPI As Workbook
Dim lr As Long, i As Long, Cell As Range, Cell2 As Range
Application.ScreenUpdating = False
Set SPISOK = Workbooks("Список сотрудников.xlsx")
Set KPI = Workbooks("KPI.xlsx")
Set LO = Workbooks("Лист оценки.xlsm")
lr = SPISOK.Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lr
LO.Worksheets(1).Range("A9:G15").ClearContents
If SPISOK.Worksheets(1).Cells(i, 1) <> "" Then
LO.Worksheets(1).Cells(3, 3) = SPISOK.Worksheets(1).Cells(i, 4) 'ФИО
LO.Worksheets(1).Cells(4, 3) = SPISOK.Worksheets(1).Cells(i, 5) 'табельный номер
LO.Worksheets(1).Cells(5, 3) = SPISOK.Worksheets(1).Cells(i, 3) 'Должность
LO.Worksheets(1).Cells(6, 3) = SPISOK.Worksheets(1).Cells(i, 2) 'Отдел

Set Cell = SPISOK.Worksheets(2).Columns(1).Find(LO.Worksheets(1).Cells(6, 3))
LO.Worksheets(1).Cells(3, 5) = SPISOK.Worksheets(2).Cells(Cell.Row, 3) 'Руководитель
LO.Worksheets(1).Cells(4, 5) = SPISOK.Worksheets(2).Cells(Cell.Row, 2) 'Должность
LO.Worksheets(1).Cells(5, 5) = SPISOK.Worksheets(2).Cells(Cell.Row, 1) 'Отдел

Set Cell2 = KPI.Worksheets(1).Columns(3).Find(SPISOK.Worksheets(1).Cells(i, 4))
x = Application.WorksheetFunction.CountIf(KPI.Worksheets(1).Columns(3), SPISOK.Worksheets(1).Cells(i, 4))

For k = 0 To x - 1
LO.Worksheets(1).Cells(9 + k, 1) = k + 1
LO.Worksheets(1).Cells(9 + k, 2) = KPI.Worksheets(1).Cells(Cell2.Row + k, 4)
LO.Worksheets(1).Cells(9 + k, 5) = KPI.Worksheets(1).Cells(Cell2.Row + k, 5)
Next k
LO.Worksheets(1).Cells(9 + k, 2) = "ИТОГ"
LO.Worksheets(1).Cells(9 + k, 5) = Application.WorksheetFunction.Sum(Range(Cells(9, 5), Cells(9 + k, 5)))

On Error Resume Next
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
    Const REPORTS_FOLDER = "Листы оценки\"
    ' создаём папку для файла, если её ещё нет
    MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    ' выбираем стартовую папку
    ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
 
    ' вывод диалогового окна для запроса имени сохраняемого файла
    Filename = LO.Worksheets(1).Cells(3, 3) & "Таб.№" & LO.Worksheets(1).Cells(4, 3) & ".xls"
    ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
    If VarType(Filename) = vbBoolean Then Exit Sub
 
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа

    ' убеждаемся, что активной книгой является копия листа
    If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
        ' сохраняем файл под заданным именем в формате Excel 2003
        ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
 
        ' закрываем сохранённый файл
        ' (удалите следующую строку, если закрывать созданный файл не требуется)
        ActiveWorkbook.Close False
    End If
End If
Next i
Application.ScreenUpdating = True
End Sub
Изменено: Mershik - 20 сен 2020 17:36:52
Заполнение файла с помощью данных из других книг Excel
 
Цитата
Arina Sh написал:
Данные по руководителю так же через ВПР из файла "Список сотрудников"/Лист "Руководитель" (данные подтягиваются в зависимости от того, в каком отделе работает сотрудник).
вы смотрите что прикладываете в качестве примера? видимо нет - нет там никакого листа кроме "Список сотрудников"
формула впр и енд с учетом пустых строк, не срабатывает так как нужно
 
Айра, но темой вы сами себе ограничили помощь....для помощи Вам - стоит описать задачу что с чем сравнивается и какие условия и наверное модераторы попросят вас предложить новое название темы отражающее суть вопроса
Изменено: Mershik - 20 сен 2020 16:30:56
Заполнение файла с помощью данных из других книг Excel
 
Arina Shichko, Вы бы показали желаемый результат одного из нужных файлов....
ваши этапы у вас в голове - поэтому одна тема один вопрос...первый этап
откуда берутся данные по руководителю?...

первый этап макрос ниже, открываете ваши 2 книги из примера приложенного вами (KPI и Список сотрудников) и затем открываете книгу которую я приложил ( это ваше же файл, но с макросом и другим расширением файла).
файлы сохраняются в ту папку где лежит файл Лист  оценки.xlsm c созданием папки.
Вопрос про руководителя открыт поэтому там подставляется что то левое)
Часть макроса состоит из макроса расположенного ТУТ
Код
Sub pattern()
Dim SPISOK As Workbook, LO As Workbook, KPI As Workbook
Dim lr As Long, i As Long
Set SPISOK = Workbooks("Список сотрудников.xlsx")
Set KPI = Workbooks("KPI.xlsx")
Set LO = Workbooks("Лист оценки.xlsm")
lr = SPISOK.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
LO.Worksheets(1).Cells(3, 3) = SPISOK.Worksheets(1).Cells(i, 3) 'ФИО
LO.Worksheets(1).Cells(4, 3) = SPISOK.Worksheets(1).Cells(i, 4) 'табельный номер
LO.Worksheets(1).Cells(5, 3) = SPISOK.Worksheets(1).Cells(i, 2) 'Должность
LO.Worksheets(1).Cells(6, 3) = SPISOK.Worksheets(1).Cells(i, 1) 'Отдел

LO.Worksheets(1).Cells(3, 5) = SPISOK.Worksheets(1).Cells(i, 1) 'Руководитель
LO.Worksheets(1).Cells(4, 5) = SPISOK.Worksheets(1).Cells(i, 1) 'Должность
LO.Worksheets(1).Cells(5, 5) = SPISOK.Worksheets(1).Cells(i, 1) 'Отдел

On Error Resume Next
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
    Const REPORTS_FOLDER = "Листы оценки\"
    ' создаём папку для файла, если её ещё нет
    MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    ' выбираем стартовую папку
    ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
 
    ' вывод диалогового окна для запроса имени сохраняемого файла
    Filename = LO.Worksheets(1).Cells(3, 3) & "Таб.№" & LO.Worksheets(1).Cells(4, 3) & ".xls"
    ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
    If VarType(Filename) = vbBoolean Then Exit Sub
 
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа

    ' убеждаемся, что активной книгой является копия листа
    If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
        ' сохраняем файл под заданным именем в формате Excel 2003
        ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
 
        ' закрываем сохранённый файл
        ' (удалите следующую строку, если закрывать созданный файл не требуется)
        ActiveWorkbook.Close False
    End If
Next i
End Sub
Изменено: Mershik - 20 сен 2020 16:24:33
формула впр и енд с учетом пустых строк, не срабатывает так как нужно
 
Айра, есл решение формулами указанными в названии темы невозможно не помогать?  
Изменено: Mershik - 20 сен 2020 16:25:18
Как при использовании функции сцепить убрать ненужные нули
 
Валерий, мой косяк - заменить со второй строки формулу на
Код
=ЕСЛИ(ИНДЕКС($A:$L;СТРОКА(P1)*3+1+1;3)>0;ИНДЕКС($A:$L;СТРОКА(P1)*3+1+1;1)&" / "&ИНДЕКС($A:$L;СТРОКА(P1)*3+1+2;1)&" / "&ИНДЕКС($A:$L;СТРОКА(P1)*3+1+2;3)&" * "&ИНДЕКС($A:$L;СТРОКА(P1)*3+1+1;4)&" * "&ИНДЕКС($A:$L;СТРОКА(P1)*3+1+1;5)&$E$1;ЕСЛИ(СЧЁТЕСЛИ($P$1:P1;ИНДЕКС($F:$F;СЧЁТЗ($C:$C)+1;1)&" "&ИНДЕКС($G:$G;СЧЁТЗ($C:$C)+1;1))>=1;"";ИНДЕКС($F:$F;СЧЁТЗ($C:$C)+1;1)&" "&ИНДЕКС($G:$G;СЧЁТЗ($C:$C)+1;1)))
Как при использовании функции сцепить убрать ненужные нули
 
Цитата
Hugo написал:
UDF
вы что упаси Боже - это же макрос) ;)  
Как при использовании функции сцепить убрать ненужные нули
 
Цитата
Валерий написал:
мне попроще нужно с кучей формул
ловите для столбца P
в строке 1 остается Ваша формула:
Код
=СЦЕПИТЬ(A2;" / ";A3;" / ";C3;" * ";D2;" * ";E2;E1)
в строку 2 формула и протянуть вниз:
Код
=ЕСЛИ(ИНДЕКС($A:$L;СТРОКА(P2)*3+1+1;3)>0;ИНДЕКС($A:$L;СТРОКА(P2)*3+1+1;1)&" / "&ИНДЕКС($A:$L;СТРОКА(P2)*3+1+2;1)&" / "&ИНДЕКС($A:$L;СТРОКА(P2)*3+1+2;3)&" * "&ИНДЕКС($A:$L;СТРОКА(P2)*3+1+1;4)&" * "&ИНДЕКС($A:$L;СТРОКА(P2)*3+1+1;5)&$E$1;ЕСЛИ(СЧЁТЕСЛИ($P$1:P2;ИНДЕКС($F:$F;СЧЁТЗ($C:$C)+1;1)&" "&ИНДЕКС($G:$G;СЧЁТЗ($C:$C)+1;1))>=1;"";ИНДЕКС($F:$F;СЧЁТЗ($C:$C)+1;1)&" "&ИНДЕКС($G:$G;СЧЁТЗ($C:$C)+1;1)))
удачи :D (зря боитесь макросов)
Как при использовании функции сцепить убрать ненужные нули
 
Валерий, ну накидал макрос, а вот формулами достаточно объемно думаю..
Код
Sub ddddddddd()
Dim i As Long, lr As Long
k = 1 ' номер строки с которой начинать вставлять результат
lr = Cells(Rows.Count, 1).End(xlUp).Row 
For i = 1 To lr Step 3
    If Cells(i + 1, 3) > 0 Then
        Cells(k, 14) = Cells(i + 1, 1) & " / " & Cells(i + 2, 1) & " / " & Cells(i + 2, 3) & " * " & Cells(i + 1, 4) & " * " & Cells(i + 1, 5) & Cells(1, 5)
        k = k + 1
    End If
Next i
    Cells(k, 14) = Cells(lr + 1, 6) & " " & Cells(lr + 1, 7)
End Sub
Изменено: Mershik - 20 сен 2020 13:34:00
Как при использовании функции сцепить убрать ненужные нули
 
Валерий, структура получается всегда такая?  строка №1 и под ней всегда 2 строк данных*??

макрос подойдет? если да то куда выводить результат?
Изменено: Mershik - 20 сен 2020 13:18:34
Перенос данных из одного столбца в конец другого, нужно из таблицы с множеством колонок собрать таблицу с двумя для ВПР
 
multsib,  для второго файла...
Код
Sub arewr()
Dim arrIN(), arrOUT(), i As Long, c As Long, lcol As Long, lr As Long
lr = Worksheets("Исходные данные").Cells(Rows.Count, 1).End(xlUp).Row
lcol = Worksheets("Исходные данные").Cells(1, Columns.Count).End(xlToLeft).Column
arrIN = Range(Cells(2, 1), Cells(lr, lcol))
ReDim arrOUT(UBound(arrIN) * lcol - 1, 1)
k = 0
For c = 1 To lcol - 1
    For i = LBound(arrIN) To UBound(arrIN)
        arrOUT(k, 0) = arrIN(i, c)
        arrOUT(k, 1) = arrIN(i, lcol)
        k = k + 1
    Next i
Next c
Worksheets("Требуемые данные").Range("D2").Resize(UBound(arrOUT), 2) = arrOUT
End Sub
Перенос данных из одного столбца в конец другого, нужно из таблицы с множеством колонок собрать таблицу с двумя для ВПР
 
multsib,
Код
Sub sds()
Dim i As Long, lr As Long, lcol As Long, c As Long
k = 2
lr = Cells(Rows.Count, 1).End(xlUp).Row
For c = 1 To 3
    For i = 2 To lr
        Cells(k, 9) = Cells(i, c)
        Cells(k, 10) = Cells(i, 4)
        k = k + 1
    Next i
Next c
End Sub
Перенос данных из одного столбца в конец другого, нужно из таблицы с множеством колонок собрать таблицу с двумя для ВПР
 
multsib, так может нужно показать нормальный пример что есть и что нужно на выходе ?
Перенос данных из одного столбца в конец другого, нужно из таблицы с множеством колонок собрать таблицу с двумя для ВПР
 
multsib, не понятно  причем тут ВПР?
Сводная таблица. Вычисляемый объект. Значение прошлого месяца, В сводную таблицу необходимо добавить значения прошлого месяца
 
ivanka, да в исходной...но думаю средствами сводной желаемого результата получить не получится..ИМХО
Изменено: Mershik - 19 сен 2020 22:09:51
Сводная таблица. Вычисляемый объект. Значение прошлого месяца, В сводную таблицу необходимо добавить значения прошлого месяца
 
ivanka,просто в конце добавите сумму по столбцам со смещением и все
Формула для автоматического вывода данных из последней строки группы
 
Цитата
dom23 написал:
сделать ее непрерывной,
ничего не понял, если вы об ограничении диапазона - измените на нужный вам - но большой запас будет тормозит файл
$32 на нужную на нужную Вам строку...
Изменено: Mershik - 19 сен 2020 14:20:19
Автоматизация возврата товара, Подбор количества по накладным
 
Dagmar, а можно напримере пары загрузок прям порядок расписать что берем это смотрим туда если то - то это, если так то этак...

и реализация только формулами?
Изменено: Mershik - 19 сен 2020 13:35:10
Поиск значения, соответствующего тексту из первой таблицы, который в другой таблице написан без слэшей
 
Цитата
derekT написал:
результат, что и зелёный
Код
=ПРОСМОТР(2;1/ПОИСК(ПОДСТАВИТЬ(Лист1!$A$4:$A$9;"/";"");A1);Лист1!$B$4:$B$9)
Поиск значения, соответствующего тексту из первой таблицы, который в другой таблице написан без слэшей
 
derekT, а что в файле исходные данные и что желаемый результат?
Формула для автоматического вывода данных из последней строки группы
 
dom23, массивная формула
Код
=ЕСЛИОШИБКА(ЕСЛИ(СЧЁТЕСЛИ(B6:ИНДЕКС(B6:B$32;ПОИСКПОЗ(ЛОЖЬ;ЕПУСТО($A6:$A$32);0)-1;1);"<>"&"")>0;ИНДЕКС(B6:B$32;ПОИСКПОЗ(ЛОЖЬ;ЕПУСТО($A6:$A$32);0)-2;1);"");ЕСЛИ(ЕПУСТО(ИНДЕКС(B6:B$32;СЧЁТЗ($B6:$B$32);1));"";ИНДЕКС(B6:B$32;СЧЁТЗ($B6:$B$32);1)))
Ширина столбца по условию, содержания текста
 
Такое только макросом,  а если ничего не содержится ?
Код
Sub ddd()
Dim c As Long
Dim lcol As Long
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
For c = 1 To lcol
    If Cells(1, c) Like "*стакан*" Then
        Columns(c).ColumnWidth = 10
    ElseIf Cells(1, c) Like "*Железный*" Then
        Columns(c).ColumnWidth = 15
    End If
Next c
End Sub
Изменено: Mershik - 19 сен 2020 12:12:17
Как просуммировать значения найденные по суммесли на всех листах, с учетом того что кол-во листов будет постоянно добавляться, никак не увязать суммессли и трехмерную ссылку
 
Ну может тут помогут... вроде так, честно не проверял результат.
Код
Sub dds()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sh As Worksheet, sh2 As Worksheet
Dim lr As Long, lr2 As Long, i As Long, k As Long
Set sh = Worksheets("формулы")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
sh.Range("D2:F" & lr + 1).ClearContents
For i = 2 To lr
    For Each sh2 In Worksheets
        If sh2.Name <> sh.Name And sh2.Name <> "шаблон" Then
            kol_vo = Application.WorksheetFunction.SumIfs(sh2.Range("G:G"), sh2.Range("B:B"), sh.Cells(i, 1), sh2.Range("C:C"), sh.Cells(i, 2), sh2.Range("E:E"), Cells(i, 3))
            Plan = Application.WorksheetFunction.SumIfs(sh2.Range("H:H"), sh2.Range("B:B"), sh.Cells(i, 1), sh2.Range("C:C"), sh.Cells(i, 2), sh2.Range("E:E"), Cells(i, 3))
            Fakt = Application.WorksheetFunction.SumIfs(sh2.Range("E:E"), sh2.Range("B:B"), sh.Cells(i, 1), sh2.Range("C:C"), sh.Cells(i, 2), sh2.Range("E:E"), Cells(i, 3))
            sh.Cells(i, 4) = sh.Cells(i, 4) + kol_vo
            sh.Cells(i, 5) = sh.Cells(i, 5) + Plan
            sh.Cells(i, 6) = sh.Cells(i, 6) + Fakt
        End If
    Next sh2
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub



Изменено: Mershik - 18 сен 2020 23:04:06
При отмене объединения ячеек текст в них сохраняется! Как?!, Необычное объединение ячеек, при отмене которого текст во всех получившихся ячейках цел.
 
phalcor, так я вам выше расписал как
Формула для расчета прогноза продаж, Формула для прогноза продаж с несколькими условиями
 
Роман Пктров, У вас гугл/яндекс заблокирован?
1. https://www.youtube.com/watch?v=vst9nKgqxZo
2. https://www.youtube.com/watch?v=5Wq3dkDgROU
3. https://support.microsoft.com/ru-ru/office/%D1%81%D0%BE%D0%B7%D0%B4%D0%B0%D0%BD%D0%B8%D0%B5-%D0%BF%D...
и т.д.
При отмене объединения ячеек текст в них сохраняется! Как?!, Необычное объединение ячеек, при отмене которого текст во всех получившихся ячейках цел.
 
Цитата
phalcor написал:
есть какая-то особая кнопочка типа "объединить без потерь"
есть - называется макрос) но его нужно написать)
Изменено: Mershik - 18 сен 2020 20:16:49
При отмене объединения ячеек текст в них сохраняется! Как?!, Необычное объединение ячеек, при отмене которого текст во всех получившихся ячейках цел.
 
Цитата
Hugo написал:
Кисточкой.
точняк) делаете в любом месте листа объединение такого же количества ячеек (которое будете объединять с данными)...пвыделяете их нажимаете формат по образцу
и выделяете нужные вам ячейки для объединения) (кажется написал - что ничего не понятно)
Изменено: Mershik - 18 сен 2020 20:14:58
При отмене объединения ячеек текст в них сохраняется! Как?!, Необычное объединение ячеек, при отмене которого текст во всех получившихся ячейках цел.
 
Михаил Витальевич С., та ну нет)
буквально в пределах месяца)
При отмене объединения ячеек текст в них сохраняется! Как?!, Необычное объединение ячеек, при отмене которого текст во всех получившихся ячейках цел.
 
phalcor, где-то недавно один из модераторов давал ответ на такой вопрос и показывал как это "исполняется" - ща поищем
Изменено: Mershik - 18 сен 2020 20:07:31
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 179 След.
Наверх