Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Узнать номер недели, месяца и года по дате в ячейке (VBA)
 
#1
23.01.2014 08:41:10
Всем доброго времени суток!!!
Перерыл интернет (может плохо рыл раз не нашел), литературку полистал, но так и не нашел метод определения по дате в ячейке номеров недели, месяца и года. Попадались похожие но не то.
Суть в том что есть столбец с датами (21.01.2014) , рядом мне необходимо вывести номер недели и месяц, каким способом это можно сделать в VBA? (ч/з формулы слишком тяжело, т.к. очень много данных)
Спасибо заранее!!!
Учусь,еще...
 
 
 
#2
23.01.2014 08:50:37
2014-ый год начался в среду. Первая неделя когда заканчивается? 5-го в воскресенье или 7-го во вторник? Номер месяца узнать из даты - это просто по формуле Месяц(). А недели - разницу в датах делишь на 7 и берешь целую часть от результата...
Если автоматизировать бардак, то получится автоматизированный бардак.
 
 
 
#3
23.01.2014 08:51:03
Номер недели:
http://www.cpearson.com/excel/WeekNumbers.aspx
месяц - month(date), год - year(date).
Я сам - дурнее всякого примера! ...
 
 
 
#4
23.01.2014 09:19:33
По поводу месяца:
Код
Dim thisDate As Date
Dim thisMonth As Integer
thisDate = Worksheets("1".Cells(1 + i, 
thisMonth = Month(thisDate)
Worksheets("1".Cells(1 + i, 10) = thisMonth
Не получается.) Извините за тупость, я только учусь...
Изменено: kolyambus55rus - 25.01.2014 06:17:31
Учусь,еще...
 
 
 
#5
23.01.2014 09:59:17
Попробуйте:
Код
sub tt ()  
Dim x% , lr%  
lr = ActiveSheet.Cells(Rows.Count, 8).End(xlUp).Row 
for x = 1 to lr step 1 
Cells(1+x,10)=month(cells(1+x,8).value)
Next x  
End sub
 
 
 
#6
23.01.2014 10:09:38
номер недели

Код
=НОМНЕДЕЛИ(A2;2)
номер месяца
Код
=МЕСЯЦ(A2)

что мешает просто протянуть 2 колонки?
Вполне такой нормальный кинжальчик. Процентов на 100
 
 
 
#7
23.01.2014 10:13:33
китин я бы с удовольствием все на формула привязал, но строк с данными свыше 100 000 и любая формула порядком увеличивает размер файла. :(
Учусь,еще...
 
 
 
#8
23.01.2014 10:23:42
Код
Sub Макрос1()
'
' Макрос1 Макрос
'

'
    ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[-1])"
    Range("C2".Select
    ActiveCell.FormulaR1C1 = "=MONTH(RC[-2])"
    Range("D2".Select
    ActiveCell.FormulaR1C1 = "=TEXT(RC[-3],""ММММ"""
    Range("E2".Select
    ActiveCell.FormulaR1C1 = "=YEAR(RC[-4])"
    Range("B2:E2".Select
    Selection.AutoFill Destination:=Range("B2:E100", Type:=xlFillDefault
    Range("B2:E100".Select
End Sub


Записано макрорекодером по формулам Китина и все работает
Изменено: seregeyss - 25.01.2014 06:19:25
Лень двигатель прогресса, доказано!!!
 
 
 
#9
23.01.2014 10:26:52
Vitallic спасибо большое!!! Может литературку грамотную подскажите, чтоб я не "мусорил" в форумах?) Я скачал "Уокенбах Дж. - Excel 2010. Профессиональное программирование на VBA - 2012". Я так понял главное выучить язык програмирования а остальное дело логики?!

Остались недельки.)  
Учусь,еще...
 
 
 
#10
23.01.2014 10:30:02
seregeyss, ну а поменять формулы на значения? На 100000 строк будет грузить.
Я сам - дурнее всякого примера! ...
 
 
 
#11
23.01.2014 11:05:50
Виноват про это забыл
Лень двигатель прогресса, доказано!!!
 
 
 
#12
23.01.2014 11:54:54
Для дальнейшего удобства (анализ в сводной таблице) я вот так сделал:
Учусь,еще...
 
 
 
#13
23.01.2014 12:02:03
kolyambus55rus, кто Вам сказал, что на форуме по Эксель уместно выкладывать картинки?
Цитата
Для дальнейшего удобства
- офигенно удобно! А так не проще, одной строкой:
Код
MsgBox MonthName(Month([a1]))

еще:
Код
MsgBox format([a1], "MMMM")

?
в а1 - дата.
Изменено: KuklP - 23.01.2014 12:06:53
Я сам - дурнее всякого примера! ...
 
 
 
#14
23.01.2014 12:13:30
KuklP конечно проще.) Спасибо!   :)

Представляю ваше возмущение, я сам, когда кто то делает глупости, так же реагирую. :)
Изменено: kolyambus55rus - 23.01.2014 12:15:10
Учусь,еще...
 
 
 
#15
23.01.2014 12:51:04
KuklP, я так понимаю ТС нужно циклом пройтись по таблице в которой 100 000 строк
с помощью msgbox это будет утомительно (долго) да и как потом анализировать (фильтровать?)
kolyambus55rus, не учел в предыдущем макросе что так много строк, а потому
тип переменных надо обьявить как long (или &)  
 
 
 
#16
23.01.2014 12:59:44
месяц меняйте на свой (не очень ориентируюсь в русских названиях ) и добавте недостающие
Код
sub tt ()  
Dim x& , lr& 
Dim a 
a = array("січень","лютий","березень")' здесь поменяйте на нужное    
lr = ActiveSheet.Cells(Rows.Count, 8).End(xlUp).Row 
for x = 1 to lr step 1 
Cells(1+x,10)=a(month(cells(1+x,8).value)-1)
Next x  
End sub
 
 
 
#17
23.01.2014 13:07:05
Я вот так забил, всё работает (только в конце пробивает 4 лишних декабря, но это не критично)
Код
Dim x&, lr&
lr = ActiveSheet.Cells(Rows.Count, 8).End(xlUp).Row
For x = 1 To lr Step 1
    Cells(1 + x, 10) = MonthName(Month(Cells(1 + x, 8).Value))
Next x
По месяцу все понятно, осталось неделя. Буду разбираться с предложенными вариантами.
Изменено: kolyambus55rus - 23.01.2014 13:18:31
Учусь,еще...
 
 
 
#18
23.01.2014 13:19:17
поменяйте нужную строку на эту (учтите что в начале цикла нужно указать х = номер первой строки с данными которые обрабатываем)
Код
   Cells( x, 10) = MonthName(Month(Cells( x, 8).Value))
 
 
 
#19
23.01.2014 13:24:21
Можно почитать Вокенбаха (указаную выше книгу), еще Б.Джелен - Застосування VBA і макросів у  Excel.
Лично я рекомендовал бы в таком порядке:
1. Вокенбах
2. Джелен
 
 
 
#20
23.01.2014 14:22:46
Загляните ещё СЮДА
 
 
 
#21
23.01.2014 14:57:58
Цитата
с помощью msgbox это будет утомительно (долго) да и как потом анализировать (фильтровать?)
Я просто показал, как можно извлечь название месяца из даты без цикла. msgbox только для примера. Переписывать код автора с картинки, знаете ли, ни времени, ни желания не было.
Я сам - дурнее всякого примера! ...
 
 
 
#22
27.01.2014 09:14:33
В итоге, в общий код макроса, для определения месяца и недели, я вставил следующий код:
Код
' Определяем месяц

Dim x&, lr&

lr = ActiveSheet.Cells(Rows.Count, 8).End(xlUp).Row
For x = 2 To lr Step 1
Cells(x, 10) = MonthName(Month(Cells(x, 8).Value))
    
'и неделю

dtmTemp = DateSerial(Year(Cells(x, 8)), 1, 1)
Do While Weekday(dtmTemp, vbMonday) <> 1
dtmTemp = dtmTemp + 1
Loop
If dtmTemp >= DateSerial(Year(Cells(x, 8)), 1, 5) Then dtmTemp = dtmTemp - 7
If Cells(x, 8) >= DateSerial(Year(Cells(x, 8)), 12, 29) Then
Temp = DateSerial(Year(Cells(x, 8)), 12, 31)
Do While Weekday(Temp, vbMonday) <> 1
Temp = Temp - 1
Loop
If Temp >= Cells(x, 8) Then
Cells(x, 9) = 1
Else
Cells(x, 9) = (Cells(x, 8) - dtmTemp) \ 7 + 1
End If
Else
If Cells(x, 8) < dtmTemp Then
Cells(x, 9) = Cells(1 + x, 9)(DateSerial(Year(Cells(x, 8)) - 1, 12, 31))
Else
Cells(x, 9) = (Cells(x, 8) - dtmTemp) \ 7 + 1
End If
End If

Next x
Если кто то будет, как и я,  искать, думаю пригодиться.   :)  

Всем большое спасибо, редко найдешь такой форум где тебе сразу помогут!  ;)

p.s. 29 декабря 2014 года распознала как 1-я неделя (что правильно) а 30 и 31 как 53.  :?:
Изменено: kolyambus55rus - 27.01.2014 09:43:41
Учусь,еще...
 
 
 
#23
27.01.2014 10:26:40
Сократим:

Код
Sub www()
Dim x&, lr&
lr = ActiveSheet.Cells(Rows.Count, 8).End(xlUp).Row
For x = 2 To lr Step 1
Cells(x, 10) = MonthName(Month(Cells(x, 8).Value)) ' Определяем месяц
Cells(x, 9) = DateDiff("ww", DateSerial(Year(Cells(x, 8).Value) - 1, 12, 31), _
Cells(x, 8).Value, vbFirstFourDays) + 1 'и номер недели
Next x
End Sub
re:P.S.  ГОСТ ИСО 8601-2001, п.2.17 "...Первой календарной неделей года считают первую неделю, содержащую первый четверг текущего года". 29 декабря 2014 года это 53-я неделя.
 
 
 
#24
27.01.2014 10:33:41
k61,Супер! Спасибо!
 
Учусь,еще...
 
 
 
#25
27.01.2014 13:53:23
k61,сейчас только заметил, вот такая картина наблюдается да 30 000 строк вниз:


Я про строку 23959 и ниже....
Изменено: kolyambus55rus - 27.01.2014 13:55:07
Учусь,еще...
 
 
 
#26
27.01.2014 13:56:26
Проверьте, где в восьмом столбце заканчиваются данные.
 
 
 
#27
27.01.2014 13:58:46
Юрий М, Там же где и на скриншоте.
Учусь,еще...
 
 
 
#28
27.01.2014 14:04:42
Всё, разобрался!) Тупанул кое в чём. Извените.
Учусь,еще...
 
 
 
#29
27.01.2014 14:10:42
И  в чём?
 
 
 
#30
27.01.2014 16:01:52
Да у меня форматированная таблица была.)
Учусь,еще...
 
 
 
Страницы: 1
Наверх