опять недели в разрезе текущей даты

vadim245 · 10 июл 2010, 12:11

vadim245 писал(а):Спасибо. почти то, что нужно. только промахиваемся на1 неделю - всегда заменяется на четверг неделей раньше

Собственно все заработало если добавить единицу вот тут
Ned = CInt(Right(poz.Value, 2)+1)

Только вот беда - если в выделение попадают пустые ячейки, то макрос падает....
Можно как-то подправить?
Спасибо

nilem · 10 июл 2010, 17:21

Например, 1002, разве не 07.01.2010? Или нужно считать только полные недели? Ну Вам виднее, уберем единичку в другом месте. Вот так пропускает пустые ячейки (если числа отформатированы как число и если нет формул).

Код: Выделить всё

Sub ДатыЧетверги()
Dim God As String, Ned As Integer, Дата As Date
Dim DN As Integer, poz As Range
Application.ScreenUpdating = False
For Each poz In Selection.SpecialCells(xlConstants)
    God = "20" & Format(Mid(poz.Value, 1, Len(poz.Value) - 2), "0#")
    Ned = CInt(Right(poz.Value, 2))
    DN = Weekday("1/1/" & God, vbMonday)
    Дата = DateAdd("ww", Ned, "1/1/" & God) + 4 - DN
    poz.Value = Дата
Next poz
Application.ScreenUpdating = True
End Sub

Avsha · 11 июл 2010, 02:03

Топик обновил в связи с актуальностью обратного конвертирования:
От номера недели к датеЕсть огромный лист. данные в котором состоят из номеров недель вида
701 год 2007 неделя 1
915 год 2009 неделя 15
1024 год 2010 неделя 24
Нужно в выделенном диапазоне ячеек все номера недель заменить
полноценными датами - четвергами указанных недель

поднимем архив...

Год и номер недели - дата
http://forum.developing.ru/showthread.php?8840

nilem · 11 июл 2010, 08:55

Avsha, никогда не знал об этом ГОСТе. Если "Первой календарной неделей года считают первую неделю, содержащую первый четверг текущего года", то так будет правильнее

Код: Выделить всё

Sub ДатыЧетверги()
Dim God As String, Ned As Integer, Дата As Date
Dim DN As Integer, poz As Range, dop As Integer
Application.ScreenUpdating = False
For Each poz In Selection.SpecialCells(xlConstants)
    God = "20" & Format(Mid(poz.Value, 1, Len(poz.Value) - 2), "0#")
    Ned = CInt(Right(poz.Value, 2))
    DN = Weekday("1/1/" & God, vbMonday)
    If DN > 4 Then dop = 0 Else dop = -1 'если 1-я неделя неполная
    Дата = DateAdd("ww", Ned + dop, "1/1/" & God) + 4 - DN
    poz.Value = Дата
Next poz
Application.ScreenUpdating = True
End Sub

Avsha · 11 июл 2010, 09:11

nilem,
вот в том и особенность, что "определение первой недели года" у функции Excel НОМНЕДЕЛИ свое, а у ГОСТа другое
что не всегда совпадает.
Поэтому все зависит от того, кто по чему работает и какое правило принимает.

vadim245 · 01 ноя 2010, 09:26

Выручайте! Вынужден снова вернуться к началу темы. Началась какая-то путаница в номерах недель (надо же было копнуть тему глубже!), которые как оказалось не соответствуют ГОСТ (например, 1 и 2 января 2011 года это еще оказывается 1052 неделя 2010 года (10-год, 52-номер недели), а не 1101 неделя (11 год 1-я неделя) ).
Каким образом при переводе даты получать такое воплощение ГОСТ:
31/12/2009= 953 неделя
01/01/2010= 953 неделя
02/01/2010= 953 неделя
03/01/2010= 953 неделя
04/01/2010= 1001 неделя
05/01/2010= 1001 неделя

Предложенные в топике алгоритмы "мажут" на 1 неделю во многих случаях, когда в календарь вмешивается ГОСТ (первая неделя года - та, на которую выпадает первый четверг)
Можно не привязывать формулу с Excel - просто подскажите в общем виде пожалуйста расчет.

Avsha · 02 ноя 2010, 15:12

По-моему, здесь также все доходчиво написано...
http://www.planetaexcel.ru/tip.php?aid=170