Макрос для группировки дат из строк
У меня есть такая информация/данные:
Могу ли я попросить помощи в создании макроса, который будет группировать даты для данного сотрудника из нескольких строк в одну, если даты идут подряд?
Я пробовал помочь с Ai, но мне это не удалось, потому что у меня все еще есть проблемы с форматированием дат и их правильным написанием, и я не могу это изменить, потому что это результат другого действия, сделанного ранее.
- макрос будет выполняться на активном листе,
- применяется только к столбцам A-D
- результат будет перенесен в столбцы P-S, которые необходимо сначала очистить
- мои данные не имеют заголовков
- строки с одиночными датами остаются такими же, какие они есть
- MS Office 2016 для небольшого офиса
Что я хотел бы получить после запуска макроса:
Спасибо
Он не отформатирован как дата. Пример файла с большим количеством данных в строках [wetransfer]: we.tl/t-SHKpLPGlFM
Насколько вы близки? Если вы опубликуете код, который пробовали, возможно, будет быстрее обнаружить ошибку, чем писать код за вас?
Какой у вас стандартный формат даты? Что-то вроде «мм/дд/гггг»…
Моя стандартная дата — дд/мм/гггг. Я закончил с ИИ на [wetransfer]: we.tl/t-Ag7YMlasWX
Должна ли последовательная дата принадлежать одному и тому же месяцу?
Нет, даты сгруппированы только по определенному месяцу. Когда начнется еще один месяц, мы начнем сначала.
Пожалуйста, протестируйте опубликованный мной код и отправьте отзыв. Я мог видеть ваш ответ, относящийся к дате, принадлежащей тому же месяцу, после того, как я подготовил эту часть кода. Если (по ошибке или по другой причине) даты указаны в разных месяцах, будут возвращены обе даты, разделенные знаком «-».
Ответы 1
Пожалуйста, попробуйте следующий код. Он использует словарь и некоторые массивы. Работая в основном в памяти и отбрасывая только обработанный результат массива, он должен работать очень быстро даже для больших диапазонов. Предполагается, что для одного и того же пользователя все данные в столбцах A, B и C одинаковы:
Sub GrupingByUser()
Dim ws As Worksheet, lastR As Long, arr, arrIT, arrFin, firstDate As Date, lastDate As Date
Dim i As Long, j As Long, dict As Object
Set ws = ActiveSheet
lastR = ws.Range("D" & ws.rows.count).End(xlUp).row 'last row on D:D
arr = ws.Range("A1:D" & lastR).Value 'place the range in an array for faster iteration
Set dict = CreateObject("scripting.Dictionary") 'set the necessary dictionary
For i = 1 To UBound(arr)
'if the first columns concatenation does not exist as a key, add it to dictionary:
If Not dict.Exists(CStr(arr(i, 1)) & "|" & arr(i, 2) & "|" & arr(i, 3)) Then
dict.Add CStr(arr(i, 1)) & "|" & arr(i, 2) & "|" & arr(i, 3), Array(arr(i, 4)) 'the item placed in an array
Else
arrIT = dict(CStr(arr(i, 1)) & "|" & arr(i, 2) & "|" & arr(i, 3)) 'extract the existing item in an array
ReDim Preserve arrIT(UBound(arrIT) + 1) 'redim the item array preserving existing
arrIT(UBound(arrIT)) = arr(i, 4) 'place the date as the last array element
dict(CStr(arr(i, 1)) & "|" & arr(i, 2) & "|" & arr(i, 3)) = arrIT 'place the array back as the dict item
End If
Next i
'redim the final array:
ReDim arrFin(1 To dict.count, 1 To 4)
'process the dictionary data and place them in the final array:
For i = 0 To dict.count - 1
arrIT = Split(dict.keys()(i), "|") 'split the key by "|" separator
For j = 0 To UBound(arrIT): arrFin(i + 1, j + 1) = arrIT(j): Next j 'place each element in its column
firstDate = MakeDateFromStr(CStr(dict.Items()(i)(0))) 'extract first date
arrIT = dict.Items()(i)
lastDate = MakeDateFromStr(CStr(arrIT(UBound(arrIT)))) 'last date
If Month(firstDate) = Month(lastDate) Then 'if both date are inside the same month:
If lastDate = firstDate Then 'if only one date:
arrFin(i + 1, 4) = firstDate
Else 'if more dates (in the same month)
arrFin(i + 1, 4) = Format(Day(firstDate), "00") & " - " & Format(lastDate, "dd/mm/yyyy")
End If
Else 'if not in the same month:
arrFin(i + 1, 4) = Format(firstDate, "dd/mm/yyyy") & " - " & Format(lastDate, "dd/mm/yyyy")
End If
Next i
'drop the processed array result, at once:
ws.Range("P1").Resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin
MsgBox "Ready..."
End Sub
Function MakeDateFromStr(d As String) As Date
MakeDateFromStr = CDate(left(d, 2) & "/" & Mid(d, 4, 2) & "/" & Right(d, 4))
End Function
Я старался комментировать каждую строку кода, так что, я думаю, это должно быть легко понять. Если что-то не совсем понятно, не стесняйтесь попросить разъяснений.
CStr(arr(i, 1)) использовался для исключения потенциальных ошибок в первом столбце (#N/A). Даже если они записаны в виде строки, VBA все равно воспринимает их как ошибку (например, #N/A понимается как Ошибка 2024). Легко написать как #Н/Д, но я не думаю, что это необходимо...
Пожалуйста, оставьте отзыв после тестирования.
после запуска здесь что-то происходит: firstDate = MakeDateFromStr(CStr(dict.Items()(i)(0))) 'extract first date' Я получил первое сообщение о не определенной функции.
@KMYozz Ups... Похоже, я пропустил публикацию этой функции. Я сделаю это сейчас.
@KMYozz ОК, функцию тоже опубликовал. Пожалуйста, протестируйте обновленный код (содержащий только функцию, способную извлекать дату из строки)...
это работает... но в результате я получил это: "07-08-2024 - 07-12-2024" и должно быть так: "08-07-2024 - 12-07-2024" или просто, если это возможно : "08 - 07.12.2024". В этом примере месяц (7 – июль) находится на втором месте (дата в формате ЕС).
@KMYozz Я спросил вас, какой у вас локальный/стандартный формат даты... Вероятно, вам следует сказать, что строковая дата у вас в другом формате. То есть я думал, что "08.07.2004" форматируется как "дд.мм.гггг". Я должен понимать, что на самом деле он отформатирован как "мм.дд.2024"? Если да, то адаптировать функцию не сложно, но вы должны это упомянуть... К сожалению, в вашем примере дата не превышает 12 в качестве первой части, и я не смог вывести значение каждой группы...
Извините, мне кажется, мы неправильно поняли друг друга. Я думал, вы спрашиваете, как я пишу дату, когда использую ее. Однако вы, вероятно, имели в виду форматирование ячейки с датой и ее сохранение. Сама ячейка не форматировалась - "Общее" и дата в ячейке - это текст где день/месяц/год.
@KMYozz Вы ответили то же самое («дд/мм/гггг»). Я думаю, что дата в примере не может означать что-то другое, кроме «дд.мм.гггг». В противном случае «8 – 12.07.2024» выглядит как период с 8 по 12 июля. Я ошибаюсь? Если нет, то дата строится в этом формате, меняя только разделитель даты (/ вместо .). Так как в моей локализации "12.07.2024" имеет значение и Excel распознает ее как Дату ("дд.мм.гггг ") Я не получаю никаких ошибок. В моем случае в обоих случаях это интерпретируется как дата. Если у вас есть AnyDesk и возможность удаленного подключения к вашему компьютеру, возможно, я пойму это лучше...
@KMYozz Это было приглашение (с вашей стороны) в чат. Я был там, я что-то писал, а тебя не было. Теперь я не вижу вашего комментария...
Извините, мне пришлось уйти. Я на работе и использую свободное время как можно больше. Но я думаю, что справился с этим, проанализировав код, потому что после изменения строки на: MakeDateFromStr = CDate(Mid(d, 4, 2) & "/" & Left(d, 2) & "/" & Right(d , 4)) работает как я и ожидал.
@KMYozz Это означает только то, что текстовая дата имеет формат «мм.дд.гггг». Я спрашивал вас конкретно об этом аспекте в своем комментарии выше. Но если да, то какое значение должно иметь «8 – 12.07.2024»? Не с 8 по 12 июля? Если так, то первая часть должна представлять день... Странно.
Я знаю, это странно. Ищу в региональных настройках но там все ок, попробую проверить форматирование ячеек и изменить на короткую дату. После этого изменения в макросе это автоматически воспринимается как реальная дата для Excel. Смысл такой, как Вы написали: "8 - 12.07.2024" - это с 8 по 12 июля 2024 года. В любом случае, это работает. Спасибо за терпение и извините за путаницу, но у меня всегда возникают проблемы с датами и временем (с макросами) в Excel, хотя я стараюсь следить за тем, чтобы данные были в правильном формате.
@KMYozz Неважно... Хорошо, что это работает для вас, даже если я не могу понять, почему... Я забыл указать следующий аспект: код будет работать, даже если соответствующие люди не отсортированы! Но старая дата должна быть первой, а самая последняя - последней... Код можно адаптировать для извлечения первого и последнего элемента словаря после их создания Date... Excel сохраняет дату в виде Long чисел. ..
Рациональная функция, но я не знаю, нужна ли она, потому что то, что я получаю от предыдущего макроса, всегда отсортировано от самого нового к самому старому. и сводку я обычно делаю за целый месяц, выбирая период от начала до указанной мной даты.
@KMYozz У меня нет с этим проблем... Я пытался подчеркнуть тот факт, что если новые записи вводятся из последней пустой строки, никакой сортировки не требуется. Код будет работать так, как вам нужно. Если есть «предыдущий макрос», его не нужно сортировать... Если бы я знал, что делает этот предыдущий макрос, возможно, интеграция этого подпрограммы будет полезной. Также с точки зрения скорости кода...
Привет, я нашел ошибку. Можно ли это решить? Если у вас есть человек, у которого есть записи с датами с 11.07.2024 по 26.07.2024 и есть, например. Если между этими датами отсутствует 2 дня, макрос по-прежнему будет отображаться в результатах как один диапазон. 11 - 26.07.2024, вместо 2 диапазонов, например: 11 - 15.07.2024 и 18 - 26.07.2024
@KMYozz Боюсь, это не какая-то ошибка... Приведенный выше код ответил на вопрос именно так, как он был сформулирован. Что вы имели в виду под «даты идут подряд»? Тогда, если вы сейчас поняли, что вопрос не очень корректно сформулирован, это другой вопрос. Конечно, проблему можно решить, но анализ дат сложнее. В таком случае было бы хорошо задать еще один вопрос, показывающий приведенный выше код, и объяснить, что еще вам нужно, связанное с обработкой непоследовательных диапазонов. Если вы отметите меня (здесь) и отправите ссылку на вопрос, я постараюсь помочь, если это возможно.
@KMYozz Если не будет доступности, кто-нибудь другой обязательно решит это требование... В любом случае вы должны четко объяснить, что нужно сделать, а также указать, возможно ли более двух таких интервалов дат. Алгоритм анализа должен быть построен более простым или более сложным в случае неопределенного количества интервалов.
Прошу прощения, но иногда пользуюсь переводчиком и возможно в этом тоже причина различий в построении запросов и комментариев. Спасибо за ответ и совет, как действовать дальше. Сделаю после работы, спокойно, с домашнего компьютера.
Нехорошо размещать картинки... Можете ли вы поместить данные во что-нибудь редактируемое? Существующая дата из столбца «D:D» имеет формат
Date?