Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Вывод информации о не рабочих днях в другую таблицу - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Вывод информации о не рабочих днях в другую таблицу (Формулы/Formulas)
Вывод информации о не рабочих днях в другую таблицу
kenn Дата: Среда, 21.10.2020, 15:41 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Добрый день!Прошу помощи в решении небольшой задачки! Существует табель учета рабочего времени в нем "Х" не рабочий день, нужно что бы со всего табеля выводилась информация о не рабочих днях в другую табличку по каждому человеку как указано в примеру желтым цветом, если это конечно возможно (в табеле около 200 объектов и 3000 строк)
К сообщению приложен файл: 9334520.xlsx (20.1 Kb)
 
Ответить
СообщениеДобрый день!Прошу помощи в решении небольшой задачки! Существует табель учета рабочего времени в нем "Х" не рабочий день, нужно что бы со всего табеля выводилась информация о не рабочих днях в другую табличку по каждому человеку как указано в примеру желтым цветом, если это конечно возможно (в табеле около 200 объектов и 3000 строк)
Автор - kenn
Дата добавления - 21.10.2020 в 15:41
NikitaDvorets Дата: Понедельник, 26.10.2020, 16:12 | Сообщение № 2
Группа: Авторы
Ранг: Ветеран
Сообщений: 557
Репутация: 126 ±
Замечаний: 0% ±

Excel 2019
Добрый день!
Проект решения:
1. Преобразовать заголовок табеля с датами в однострочный в другой таблице.
2. Создать в ней отдельный столбец E для перечня дат отсутствия.
3. Запустить макрос для диапазона
Код
F3:AJ23
. Диапазон можно расширить, указав параметры цикла в макросе.
4. Макрос записывает перечень дат отсутствия в соответствующие ячейки столбца E.

[vba]
Код
Sub Merge_To_One_Cell()
    Dim icur, jcur As Integer
    Dim sMergeStr As String
    Dim sMergeStr1 As String
    Dim sMergetab0 As String
    ActiveWorkbook.Sheets("input_table").Select
    ' ActiveSheet.Select
For icur = 4 To 22 Step 1

       sMergetab1 = " "

For jcur = 6 To 31 Step 1
     sMergeStr = CStr(ActiveWorkbook.Sheets("input_table").Cells(icur, jcur))
                       
        If sMergeStr Like "x" Then
               
        sMergetab = CStr(ActiveWorkbook.Sheets("input_table").Cells(3, jcur))
        sMergetab1 = sMergetab1 & sMergetab & ", "  ' собираем данные
       
       GoTo finish
        ElseIf sMergeStr = " " Or sMergeStr = "1" Then
        GoTo finish
              
finish:
        End If
                    
        Next jcur
      
        ActiveWorkbook.Sheets("input_table").Cells(icur, 5) = sMergetab1
                       
        Next icur
               
End Sub
[/vba]
Файл с проектом решения прилагается.
К сообщению приложен файл: 9334520-solutio.xlsm (31.5 Kb)
 
Ответить
СообщениеДобрый день!
Проект решения:
1. Преобразовать заголовок табеля с датами в однострочный в другой таблице.
2. Создать в ней отдельный столбец E для перечня дат отсутствия.
3. Запустить макрос для диапазона
Код
F3:AJ23
. Диапазон можно расширить, указав параметры цикла в макросе.
4. Макрос записывает перечень дат отсутствия в соответствующие ячейки столбца E.

[vba]
Код
Sub Merge_To_One_Cell()
    Dim icur, jcur As Integer
    Dim sMergeStr As String
    Dim sMergeStr1 As String
    Dim sMergetab0 As String
    ActiveWorkbook.Sheets("input_table").Select
    ' ActiveSheet.Select
For icur = 4 To 22 Step 1

       sMergetab1 = " "

For jcur = 6 To 31 Step 1
     sMergeStr = CStr(ActiveWorkbook.Sheets("input_table").Cells(icur, jcur))
                       
        If sMergeStr Like "x" Then
               
        sMergetab = CStr(ActiveWorkbook.Sheets("input_table").Cells(3, jcur))
        sMergetab1 = sMergetab1 & sMergetab & ", "  ' собираем данные
       
       GoTo finish
        ElseIf sMergeStr = " " Or sMergeStr = "1" Then
        GoTo finish
              
finish:
        End If
                    
        Next jcur
      
        ActiveWorkbook.Sheets("input_table").Cells(icur, 5) = sMergetab1
                       
        Next icur
               
End Sub
[/vba]
Файл с проектом решения прилагается.
Автор - NikitaDvorets
Дата добавления - 26.10.2020 в 16:12
kenn Дата: Понедельник, 26.10.2020, 19:08 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
NikitaDvorets, Добрый день! Огромное спасибо за помощь и потраченное время! А возможно сделать так что бы данные отображались со всего табеля в одном месте "оказание услуг", а не в каждой строке не удобен поиск информации.
 
Ответить
СообщениеNikitaDvorets, Добрый день! Огромное спасибо за помощь и потраченное время! А возможно сделать так что бы данные отображались со всего табеля в одном месте "оказание услуг", а не в каждой строке не удобен поиск информации.
Автор - kenn
Дата добавления - 26.10.2020 в 19:08
NikitaDvorets Дата: Вторник, 27.10.2020, 11:30 | Сообщение № 4
Группа: Авторы
Ранг: Ветеран
Сообщений: 557
Репутация: 126 ±
Замечаний: 0% ±

Excel 2019
Добрый день.
Цитата
А возможно сделать так что бы данные отображались со всего табеля в одном месте "оказание услуг", а не в каждой строке не удобен поиск информации.


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


Сообщение отредактировал NikitaDvorets - Вторник, 27.10.2020, 11:33
 
Ответить
СообщениеДобрый день.
Цитата
А возможно сделать так что бы данные отображались со всего табеля в одном месте "оказание услуг", а не в каждой строке не удобен поиск информации.


Для ответа на этот вопрос просьба прислать макет таблицы, которую Вы хотите видеть.
Автор - NikitaDvorets
Дата добавления - 27.10.2020 в 11:30
kenn Дата: Вторник, 27.10.2020, 13:16 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
NikitaDvorets, Добрый день!
К сообщению приложен файл: 2334279.xlsx (20.1 Kb)
 
Ответить
СообщениеNikitaDvorets, Добрый день!
Автор - kenn
Дата добавления - 27.10.2020 в 13:16
NikitaDvorets Дата: Вторник, 27.10.2020, 14:56 | Сообщение № 6
Группа: Авторы
Ранг: Ветеран
Сообщений: 557
Репутация: 126 ±
Замечаний: 0% ±

Excel 2019
Добрый день.
Проект макроса усовершенствован.
Найденные результаты записываются в итоговую таблицу Табель фио-пропуски .
К сообщению приложен файл: 9334520-result.xlsm (32.3 Kb)


Сообщение отредактировал NikitaDvorets - Вторник, 27.10.2020, 14:58
 
Ответить
СообщениеДобрый день.
Проект макроса усовершенствован.
Найденные результаты записываются в итоговую таблицу Табель фио-пропуски .
Автор - NikitaDvorets
Дата добавления - 27.10.2020 в 14:56
kenn Дата: Вторник, 27.10.2020, 17:41 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
NikitaDvorets, Добрый день! Меняю в Вашем файле во вкладке табель фамилии сотрудников, запускаю макрос, но не чего не происходит фамилии остаются старые в остальных двух вкладках. Может я что-то не так делаю?
 
Ответить
СообщениеNikitaDvorets, Добрый день! Меняю в Вашем файле во вкладке табель фамилии сотрудников, запускаю макрос, но не чего не происходит фамилии остаются старые в остальных двух вкладках. Может я что-то не так делаю?
Автор - kenn
Дата добавления - 27.10.2020 в 17:41
NikitaDvorets Дата: Вторник, 27.10.2020, 18:17 | Сообщение № 8
Группа: Авторы
Ранг: Ветеран
Сообщений: 557
Репутация: 126 ±
Замечаний: 0% ±

Excel 2019
Добрый день.
Цитата
Может я что-то не так делаю?

Вторая таблица не связана с Вашим первоначальным вариантом табеля с двух-строчным календарём, она представляет данные в другой форме, гораздо более удобной для применения макроса.
Чтобы ответить на Ваш вопрос, нужен этот измененный (итоговый) табель.
 
Ответить
СообщениеДобрый день.
Цитата
Может я что-то не так делаю?

Вторая таблица не связана с Вашим первоначальным вариантом табеля с двух-строчным календарём, она представляет данные в другой форме, гораздо более удобной для применения макроса.
Чтобы ответить на Ваш вопрос, нужен этот измененный (итоговый) табель.
Автор - NikitaDvorets
Дата добавления - 27.10.2020 в 18:17
kenn Дата: Вторник, 27.10.2020, 18:33 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
NikitaDvorets, поменял фамилии во вкладке табель
К сообщению приложен файл: 9334520-result-.xlsm (30.8 Kb)
 
Ответить
СообщениеNikitaDvorets, поменял фамилии во вкладке табель
Автор - kenn
Дата добавления - 27.10.2020 в 18:33
NikitaDvorets Дата: Среда, 28.10.2020, 11:09 | Сообщение № 10
Группа: Авторы
Ранг: Ветеран
Сообщений: 557
Репутация: 126 ±
Замечаний: 0% ±

Excel 2019
Добрый день.
Таблица input_table отредактирована в соответствии с новым табелем.
Макрос формирует доп. столбец "Число дней отсутствия" на листе "Табель фио-пропуски".
К сообщению приложен файл: 0508922.xlsm (29.8 Kb)
 
Ответить
СообщениеДобрый день.
Таблица input_table отредактирована в соответствии с новым табелем.
Макрос формирует доп. столбец "Число дней отсутствия" на листе "Табель фио-пропуски".
Автор - NikitaDvorets
Дата добавления - 28.10.2020 в 11:09
kenn Дата: Среда, 28.10.2020, 12:10 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
NikitaDvorets, Добрый день! Не пойму в какую вкладку мне нужно заносить данные? Я так понял что данные нужно вносить данные во вкладку "инпут", т.е. получается мне сначала надо заполнить вкладку табель, потом заполнить вкладку инпут, после чего запустить макрос.


Сообщение отредактировал kenn - Среда, 28.10.2020, 12:28
 
Ответить
СообщениеNikitaDvorets, Добрый день! Не пойму в какую вкладку мне нужно заносить данные? Я так понял что данные нужно вносить данные во вкладку "инпут", т.е. получается мне сначала надо заполнить вкладку табель, потом заполнить вкладку инпут, после чего запустить макрос.
Автор - kenn
Дата добавления - 28.10.2020 в 12:10
MikeVol Дата: Среда, 28.10.2020, 12:43 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
kenn, День Добрый. Я тут по игрался чуток с листами. Теперь вводите данные на листе табель и он автоматом выводит их же и на лист input_table, при помощи выпадающего списка. Кроме столбца не работал, это не осилил я. Но теперь макрос дублирует фамилии, это тоже не осилил. Может быть NikitaDvorets, по калдует над кодом. Как вариант файл прилагаю.
К сообщению приложен файл: 28.10.20.xlsm (33.6 Kb)

Ученик.
 
Ответить
Сообщениеkenn, День Добрый. Я тут по игрался чуток с листами. Теперь вводите данные на листе табель и он автоматом выводит их же и на лист input_table, при помощи выпадающего списка. Кроме столбца не работал, это не осилил я. Но теперь макрос дублирует фамилии, это тоже не осилил. Может быть NikitaDvorets, по калдует над кодом. Как вариант файл прилагаю.
Автор - MikeVol
Дата добавления - 28.10.2020 в 12:43
NikitaDvorets Дата: Среда, 28.10.2020, 12:47 | Сообщение № 13
Группа: Авторы
Ранг: Ветеран
Сообщений: 557
Репутация: 126 ±
Замечаний: 0% ±

Excel 2019
Добрый день.
Макрос был настроен на 22 строки, сейчас он исправлен до 4000 строк.
Последовательность действий в прилагаемом файле:
1. Занести данные только в input_table.
2. Запустить исправленный макрос
К сообщению приложен файл: 0040488.xlsm (29.9 Kb)


Сообщение отредактировал NikitaDvorets - Среда, 28.10.2020, 12:49
 
Ответить
СообщениеДобрый день.
Макрос был настроен на 22 строки, сейчас он исправлен до 4000 строк.
Последовательность действий в прилагаемом файле:
1. Занести данные только в input_table.
2. Запустить исправленный макрос
Автор - NikitaDvorets
Дата добавления - 28.10.2020 в 12:47
kenn Дата: Среда, 28.10.2020, 13:01 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
MikeVol, NikitaDvorets, Спасибо что откликнулись в оказании помощи! Очень благодарю Вас!
 
Ответить
СообщениеMikeVol, NikitaDvorets, Спасибо что откликнулись в оказании помощи! Очень благодарю Вас!
Автор - kenn
Дата добавления - 28.10.2020 в 13:01
Nic70y Дата: Среда, 28.10.2020, 13:18 | Сообщение № 15
Группа: Друзья
Ранг: Экселист
Сообщений: 8761
Репутация: 2273 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub Prohoolschiki()
    Application.ScreenUpdating = False
    
    ar = Array("E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S")
    
    aa = Cells(Rows.Count, "w").End(xlUp).Row
    If aa < 9 Then aa = 9
    Range("w9:x" & aa).Clear
    
    ba = Cells(Rows.Count, "d").End(xlUp).Row
    Range("v9:v" & ba).FormulaR1C1 = "=MOD(ROW()-1,2)+1"
    Range("w9:w" & ba) = Range("d9:d" & ba).Value
    ActiveSheet.Range("w9:w" & ba).RemoveDuplicates Columns:=1, Header:=xlNo
    
    ca = Cells(Rows.Count, "w").End(xlUp).Row
    For Each cb In Range("w9:w" & ca)
        cr = cb.Row
        For cc = 1 To 15
            cd = Application.Index(ar, cc)
            ce = Evaluate("=COUNTIFS(D9:D" & ba & ",W" & cr & ",V9:V" & ba & ",1," & cd & "9:" & cd & ba & ",1)")
            cf = Range("x" & cr).Value
            cg = ","
            If cf = "" Then cg = ""
            If ce = 0 Then Range("x" & cr) = cf & cg & Range(cd & 6).Value
        Next cc
        For fc = 1 To 15
            cd = Application.Index(ar, fc)
            ce = Evaluate("=COUNTIFS(D9:D" & ba & ",W" & cr & ",V9:V" & ba & ",2," & cd & "9:" & cd & ba & ",1)")
            cf = Range("x" & cr).Value
            cg = ","
            If cf = "" Then cg = ""
            If ce = 0 Then Range("x" & cr) = cf & cg & Range(cd & 7).Value
        Next fc
        
        If Range("x" & cr) = "" Then Range("w" & cr).Clear
    Next

    Range("w9:x" & ca).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

    Range("v9:v" & ba).Clear
    
    Application.ScreenUpdating = True
End Sub
[/vba]ну а как без извращений :)
К сообщению приложен файл: 38.xlsm (27.0 Kb)

ЮMoney 41001841029809
 
Ответить
Сообщение[vba]
Код
Sub Prohoolschiki()
    Application.ScreenUpdating = False
    
    ar = Array("E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S")
    
    aa = Cells(Rows.Count, "w").End(xlUp).Row
    If aa < 9 Then aa = 9
    Range("w9:x" & aa).Clear
    
    ba = Cells(Rows.Count, "d").End(xlUp).Row
    Range("v9:v" & ba).FormulaR1C1 = "=MOD(ROW()-1,2)+1"
    Range("w9:w" & ba) = Range("d9:d" & ba).Value
    ActiveSheet.Range("w9:w" & ba).RemoveDuplicates Columns:=1, Header:=xlNo
    
    ca = Cells(Rows.Count, "w").End(xlUp).Row
    For Each cb In Range("w9:w" & ca)
        cr = cb.Row
        For cc = 1 To 15
            cd = Application.Index(ar, cc)
            ce = Evaluate("=COUNTIFS(D9:D" & ba & ",W" & cr & ",V9:V" & ba & ",1," & cd & "9:" & cd & ba & ",1)")
            cf = Range("x" & cr).Value
            cg = ","
            If cf = "" Then cg = ""
            If ce = 0 Then Range("x" & cr) = cf & cg & Range(cd & 6).Value
        Next cc
        For fc = 1 To 15
            cd = Application.Index(ar, fc)
            ce = Evaluate("=COUNTIFS(D9:D" & ba & ",W" & cr & ",V9:V" & ba & ",2," & cd & "9:" & cd & ba & ",1)")
            cf = Range("x" & cr).Value
            cg = ","
            If cf = "" Then cg = ""
            If ce = 0 Then Range("x" & cr) = cf & cg & Range(cd & 7).Value
        Next fc
        
        If Range("x" & cr) = "" Then Range("w" & cr).Clear
    Next

    Range("w9:x" & ca).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

    Range("v9:v" & ba).Clear
    
    Application.ScreenUpdating = True
End Sub
[/vba]ну а как без извращений :)
Автор - Nic70y
Дата добавления - 28.10.2020 в 13:18
kenn Дата: Среда, 28.10.2020, 14:13 | Сообщение № 16
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Nic70y, Добрый день! Это какое то Волшебство! hands СПАСИБО!!!
 
Ответить
СообщениеNic70y, Добрый день! Это какое то Волшебство! hands СПАСИБО!!!
Автор - kenn
Дата добавления - 28.10.2020 в 14:13
Nic70y Дата: Среда, 28.10.2020, 14:44 | Сообщение № 17
Группа: Друзья
Ранг: Экселист
Сообщений: 8761
Репутация: 2273 ±
Замечаний: 0% ±

Excel 2010
обнаружил маленький косяк[vba]
Код
Range("w9:x" & ca).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
[/vba]замените на[vba]
Код
Range("w9:x" & ca + 1).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
[/vba]

ЮMoney 41001841029809
 
Ответить
Сообщениеобнаружил маленький косяк[vba]
Код
Range("w9:x" & ca).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
[/vba]замените на[vba]
Код
Range("w9:x" & ca + 1).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
[/vba]
Автор - Nic70y
Дата добавления - 28.10.2020 в 14:44
kenn Дата: Среда, 28.10.2020, 14:57 | Сообщение № 18
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Nic70y, Хорошо! Спасибо!
 
Ответить
СообщениеNic70y, Хорошо! Спасибо!
Автор - kenn
Дата добавления - 28.10.2020 в 14:57
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Вывод информации о не рабочих днях в другую таблицу (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!