Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Заполнение пропущенных дат с интервалом в сутки
 
#1
06.01.2020 13:34:48
Здравствуйте дорогие друзья!!!
Имею файл ДАНО, генерируемый аппаратом для регистрации рабочего времени работников. В этом файле сгенерированны отметки работников организации. Но есть проблема. Когда у работника отсутствует отметка, то дата тоже пропускается.То есть скажем после 20/11/19 сразу следует строка 25/11/19. И приходится вручную добавлять строки с пропущенными датами как в файле РЕЗУЛЬТАТ. У всех работников должны присутствовать даты отчётного периода, на примере начало 20/11/19, а конец 19/12/19.   В связи с чем вопрос, можно ли автоматизировать этот процесс?

Заранее спасибо всем!!!  
Изменено: webulus - 09.01.2020 12:54:36
 
 
 
#2
06.01.2020 14:02:26
Цитата
webulus написал:
приходится вручную добавлять строки с пропущенными датами как в файле  РЕЗУЛЬТАТ.xlsx  (21.61 КБ). У всех работников должны присутствовать даты отчётного периода, на примере начало 20/11/19, а конец 19/12/19.   В связи с чем вопрос, можно ли автоматизировать этот процесс?
если вопрос именно - можно ли автоматизировать этот процесс? ,то ответ - да. записать макрорекордером добавление строки,  а потом вручную протяжка значений и дат.
было бы название темы подходящее, то можно было бы попробовать сделать в Power Query
 
 
 
#3
06.01.2020 14:23:04
Доброе время суток
Вариант на том самом Power Query
Господа модераторы, вариант название. Заполнение пропущенных дат с интервалом в сутки, принимая за начало/конец данных дат минимум/максимум в исходных данных.
 
 
 
#4
06.01.2020 14:37:44
Андрей VG, artyrH, А с помощью макросов как можно осуществить?
 
 
 
#5
06.01.2020 14:40:45
Цитата
webulus написал:
А с помощью макросов как можно осуществить?
Написать код, который
Находит максимальную минимальную дату
Создаёт список дат с шагом в сутки от минимальной даты к максимальной
Для каждого ID пробегает по сформированному списку дат и если даты для данного ID нет, то записывает для строку данных, если же есть переписывает существующие данные
Как-то так на вскидку.
 
 
 
#6
06.01.2020 16:45:09
Вариант формулами.
 
Изменено: БМВ - 09.01.2020 16:41:14
По вопросам из тем форума, личку не читаю.
 
 
 
#7
07.01.2020 12:35:41
Здравствуйте,Андрей VG, если не затруднит Вас не могли бы Вы двумя словами обяснить как это сделать с PQ?
 
 
 
#8
07.01.2020 18:49:59
webulus, написал
Цитата
А с помощью макросов как можно осуществить?
В книгу Дано вставил лист Результат, в котором проставил: начальная дата в C1, конечная в D1
С листа Дано запустить макрос
Код
'начальная дата в C1 конечная в D1
Sub iDataSeries()
Dim iLR_н As Long          'начальная строка блока
Dim iLR_к As Long          'конечная строка блока
Dim iLR_Unic As Long
Dim i As Long
Dim FoundID As Range
Dim iFoundDate As Range
Dim FAdr As String
Dim Result As Worksheet
 iLR_Unic = Cells(Rows.Count, "A").End(xlUp).Row
 Range("S1:S" & iLR_Unic).ClearContents
 Range("A2:A" & iLR_Unic).AdvancedFilter xlFilterCopy, CopyToRange:=Range("S1"), Unique:=True
  iLR_Unic = Cells(Rows.Count, "S").End(xlUp).Row
  Set Result = ThisWorkbook.Worksheets("Результат")
   iLR_н = Result.Cells(Result.Rows.Count, "A").End(xlUp).Row + 1
   Result.Range("A3:P" & iLR_н).ClearContents   'очищаем лист Результат
 For i = 2 To iLR_Unic     'цикл по уникальным ID
  With Result
   iLR_н = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
   .Cells(iLR_н, "H") = .Range("C1")  'начальная дата в ячейке C & iLastRow+1
    .Cells(iLR_н, "H").DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlDay, Step:=1, Stop:=.Range("D1"), Trend:=False
    iLR_к = .Cells(.Rows.Count, "H").End(xlUp).Row
    .Range("H3:H" & iLR_к).NumberFormat = "dd.mm.yyyy"
   Set FoundID = Columns(1).Find(Cells(i, "S"), , xlValues, xlWhole)
    FAdr = FoundID.Address                     'адрес первого вхождения Id
    Range("A" & FoundID.Row & ":E" & FoundID.Row).Copy .Cells(iLR_н, "A")
    .Range(.Cells(iLR_н, "A"), .Cells(iLR_н, "E")).Resize(iLR_к - iLR_н + 1).FillDown
    Do
    'ищем дату из Н на листе Результат в диапазоне от iLR_н до iLR_к
    Set iFoundDate = .Range(.Cells(iLR_н, "H"), .Cells(iLR_к, "H")).Find(Cells(FoundID.Row, "H"), , xlFormulas, xlWhole)
      Range("I" & FoundID.Row & ":L" & FoundID.Row).Copy .Cells(iFoundDate.Row, "I")
      Set FoundID = Columns(1).Find(Cells(i, "S"), After:=FoundID, LookIn:=xlValues, LookAt:=xlWhole)
    Loop While FoundID.Address <> FAdr
  End With
 Next
End Sub
 
 
 
#9
09.01.2020 12:41:42
Здравствуйте!
При обработке ДАНО.xlsx (11.75 КБ) с помощью макроса:
Код
'начальная дата в C1 конечная в D1Sub iDataSeries()
Dim iLR_н As Long          'начальная строка блока
Dim iLR_к As Long          'конечная строка блока
Dim iLR_Unic As Long
Dim i As Long
Dim FoundID As Range
Dim iFoundDate As Range
Dim FAdr As String
Dim Result As Worksheet
 iLR_Unic = Cells(Rows.Count, "A").End(xlUp).Row
 Range("S1:S" & iLR_Unic).ClearContents
 Range("A2:A" & iLR_Unic).AdvancedFilter xlFilterCopy, CopyToRange:=Range("S1"), Unique:=True
  iLR_Unic = Cells(Rows.Count, "S").End(xlUp).Row
  Set Result = ThisWorkbook.Worksheets("Результат")
   iLR_н = Result.Cells(Result.Rows.Count, "A").End(xlUp).Row + 1
   Result.Range("A3:P" & iLR_н).ClearContents   'очищаем лист Результат
 For i = 2 To iLR_Unic     'цикл по уникальным ID
  With Result
   iLR_н = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
   .Cells(iLR_н, "H") = .Range("C1")  'начальная дата в ячейке C & iLastRow+1
    .Cells(iLR_н, "H").DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlDay, Step:=1, Stop:=.Range("D1"), Trend:=False
    iLR_к = .Cells(.Rows.Count, "H").End(xlUp).Row
    .Range("H3:H" & iLR_к).NumberFormat = "dd.mm.yyyy"
   Set FoundID = Columns(1).Find(Cells(i, "S"), , xlValues, xlWhole)
    FAdr = FoundID.Address                     'адрес первого вхождения Id
    Range("A" & FoundID.Row & ":E" & FoundID.Row).Copy .Cells(iLR_н, "A")
    .Range(.Cells(iLR_н, "A"), .Cells(iLR_н, "E")).Resize(iLR_к - iLR_н + 1).FillDown
    Do
    'ищем дату из Н на листе Результат в диапазоне от iLR_н до iLR_к
    Set iFoundDate = .Range(.Cells(iLR_н, "H"), .Cells(iLR_к, "H")).Find(Cells(FoundID.Row, "H"), , xlFormulas, xlWhole)
      Range("I" & FoundID.Row & ":L" & FoundID.Row).Copy .Cells(iFoundDate.Row, "I")
      Set FoundID = Columns(1).Find(Cells(i, "S"), After:=FoundID, LookIn:=xlValues, LookAt:=xlWhole)
    Loop While FoundID.Address <> FAdr
  End With
 Next
End Sub
Выходит ошибка
 
Подскажите пожалуйста, как исправить.
Изменено: webulus - 09.01.2020 12:42:53
 
 
 
#10
09.01.2020 13:01:55
Видимо, не может найти дату на листе Результат.
Попробуйте так. Вставьте код
Код
    Set iFoundDate = Nothing
    Set iFoundDate = .Range(.Cells(iLR_н, "H"), .Cells(iLR_к, "H")).Find(Cells(FoundID.Row, "H"), , xlFormulas, xlWhole)
    If iFoundDate Is Nothing Then Set iFoundDate = .Cells(.Rows.Count, "H").End(xlUp).Cells(2, 1)
вместо строки
Код
    Set iFoundDate = .Range(.Cells(iLR_н, "H"), .Cells(iLR_к, "H")).Find(Cells(FoundID.Row, "H"), , xlFormulas, xlWhole)
Повторить ошибку без файла примера с конкретными данными не смог. Так что, гадаю вслепую.
 
 
 
#11
09.01.2020 13:07:42
webulus,  А смысл?
По вопросам из тем форума, личку не читаю.
 
 
 
#12
09.01.2020 17:53:44
webulus, написал
Цитата
Подскажите пожалуйста, как исправить.
У вас в книге нет листа Результат, видимо вы не прочитали мое сообщение #8.
 
 
 
#13
10.01.2020 07:36:43
Как Вы мне объяснили, Я создал лист с названием "Результат", от в котором проставил: начальная дата в C1, конечная в D1. С листа с данными запустил макрос, в данном примере все отлично обработалась. Потом макрос перенёс на реальный рабочий файл, там макрос даёт ошибку. Я посмотрел разницу между файлом примером и рабочим файлом. В рабочем файле оказалось, что бывают случаи когда работник пришёл в какой то день и отработал, но забыл поставить отметку на приход и уход. Соответственно в столбце I или K в строке возникает пробел и на этом пробеле останавливается макрос.
 
 
 
#14
10.01.2020 07:42:31
Цитата
webulus написал:
оказалось, что бывают случаи
это просто исправить.
По вопросам из тем форума, личку не читаю.
 
 
 
Страницы: 1
Наверх