Оптимизация проверки дней в месяце

@Deimos_ · Регистрация: 24.11.2014

Студворк — интернет-сервис помощи студентам

Задача - Проверка, сколько дней содержит текущий месяц

есть вот такой код точнее мракобесие

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
  '=========================Удаление текущего месяца===========================
    Dim ILastRow As Long
    Dim ILastCollumn As Long
    Dim Data as Date
    Data = Date        '===Установка текушей даты на данный момент.
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ILastRow = Cells(Rows.Count, 1).End(xlUp).Row                            '===Нахождение последней строки
    ILastCollumn = Cells(1, Columns.Count).End(xlToLeft).Column              '===Нахождение последней колонки
    sCopyAddress = Range(Cells(2, 1), Cells(ILastRow, ILastCollumn)).Address '===Создает диапазон ячеек из текуших переменных.
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
   [B] Day = DateSerial(Year(Data), Month(Data), 1)
    If DateSerial(Year(Data), Month(Data) + 1, 1) - 1 = Day + 30 Then
    ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=Array( _
        Day, Day + 1, Day + 2, Day + 3, Day + 4, Day + 5, Day + 6, Day + 7, Day + 8, Day + 9, _
        Day + 10, Day + 11, Day + 12, Day + 13, Day + 14, Day + 15, Day + 16, Day + 17, Day + 18, _
        Day + 19, Day + 20, Day + 21, Day + 22, Day + 23, Day + 24, Day + 25, Day + 26, Day + 27, _
        Day + 28, Day + 29, Day + 30), Operator:=xlFilterValues
    Else
    ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=Array( _
        Day, Day + 1, Day + 2, Day + 3, Day + 4, Day + 5, Day + 6, Day + 7, Day + 8, Day + 9, _
        Day + 10, Day + 11, Day + 12, Day + 13, Day + 14, Day + 15, Day + 16, Day + 17, Day + 18, _
        Day + 19, Day + 20, Day + 21, Day + 22, Day + 23, Day + 24, Day + 25, Day + 26, Day + 27, _
        Day + 28, Day + 29), Operator:=xlFilterValues
    End If[/B]
 
    Range(sCopyAddress).Select    '===Выделение диапазона по фильтру даты.
    Selection.Delete Shift:=xlUp    '===Удаление выделенных ячеек
    
    ILastCollumn = Cells(1, Columns.Count).End(xlToLeft).Column              '===Нахождение последней строки
    sCopyAddress = Range(Cells(1, 1), Cells(1, ILastCollumn)).Address       '===Нахождение последней колонки
    ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6                          '===Очистка книги от фильтра.
    '====================Удаление текущего месяца -конец-===========================
    '=====================================================================

Проблема в том что у меня этот код проверяет месяца в которых содержаться только по 30 или 31 день
А как сделать проверку на 29 28 дней для Февраля например?

@Апострофф · 17.11.2015, 13:15

Определить количество дней в текущем месяце

@Deimos_ · 17.11.2015, 14:25 **[ТС]**

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Data = Date
    Day = DateSerial(year(Data), month(Data), 1)
    LastDay = DateSerial(year(Data), month(Data) + 1, 1) - 1
    DifferentDays = DateDiff("d", Day, LastDay)
    Select Case DifferentDays
    Case 28
    ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=Array( _
        Day, Day + 1, Day + 2, Day + 3, Day + 4, Day + 5, Day + 6, Day + 7, Day + 8, Day + 9, _
        Day + 10, Day + 11, Day + 12, Day + 13, Day + 14, Day + 15, Day + 16, Day + 17, Day + 18, _
        Day + 19, Day + 20, Day + 21, Day + 22, Day + 23, Day + 24, Day + 25, Day + 26, Day + 27), Operator:=xlFilterValues
    Case 29
        ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=Array( _
        Day, Day + 1, Day + 2, Day + 3, Day + 4, Day + 5, Day + 6, Day + 7, Day + 8, Day + 9, _
        Day + 10, Day + 11, Day + 12, Day + 13, Day + 14, Day + 15, Day + 16, Day + 17, Day + 18, _
        Day + 19, Day + 20, Day + 21, Day + 22, Day + 23, Day + 24, Day + 25, Day + 26, Day + 27, _
        Day + 28), Operator:=xlFilterValues
    Case 30
        ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=Array( _
        Day, Day + 1, Day + 2, Day + 3, Day + 4, Day + 5, Day + 6, Day + 7, Day + 8, Day + 9, _
        Day + 10, Day + 11, Day + 12, Day + 13, Day + 14, Day + 15, Day + 16, Day + 17, Day + 18, _
        Day + 19, Day + 20, Day + 21, Day + 22, Day + 23, Day + 24, Day + 25, Day + 26, Day + 27, _
        Day + 28, Day + 29), Operator:=xlFilterValues
    Case 31
    ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=Array( _
        Day, Day + 1, Day + 2, Day + 3, Day + 4, Day + 5, Day + 6, Day + 7, Day + 8, Day + 9, _
        Day + 10, Day + 11, Day + 12, Day + 13, Day + 14, Day + 15, Day + 16, Day + 17, Day + 18, _
        Day + 19, Day + 20, Day + 21, Day + 22, Day + 23, Day + 24, Day + 25, Day + 26, Day + 27, _
        Day + 28, Day + 29, Day + 30), Operator:=xlFilterValues
    End Select

За команду DateDiff большое спасибо теперь полсденяя проблема осталась как можно по меньше сделать строчек для фильтра?
Можно ли как то это сложение воткнуть в for. Что бы прибавлять дни можно было в цикле и они так же бы давали эти дни для фильра.
Как это делается в том же C#

Добавлено через 17 минут
Всем спасибо сам нашел решение.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Dim SUM As Date
Select Case DifferentDays
    Case 28
        For i = 0 To 28
            SUM = Day + i
            ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
        Next i
    Case 29
        For i = 0 To 29
            SUM = Day + i
            ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
        Next i
    Case 30
        For i = 0 To 30
            SUM = Day + i
            ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
        Next i
    Case 31
        For i = 0 To 31
            SUM = Day + i
            ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
        Next i
    End Select

Добавлено через 5 минут
Еще одна проблема как теперь все это запихнуть в функцию как в C#
И вызывать её потом где тебе душе угодно в теле макроса.

C#
1
2
3
4
5
6
7
8
9
10
11
12
Public void SomeFunc()
{
   Console.WriteLine("Sample text, Sample Text");
   ...
   ...
   ...
}
 
Static void Main(args e)
{
   SomeFunc();
}

SoftIce · 17.11.2015, 14:46

Visual Basic
1
2
3
4
5
6
7
8
Private Sub SomeSub(s as string)
   msgbox s
End Sub
 
Public Sub Main()
      SomeSub "Sample text, Sample Text"
      SomeSub "Another text"
end sub

@Deimos_ · 17.11.2015, 14:51 **[ТС]**

А можно без вложенных стринговых переменных просто вызывать её?
И где этот код писать в этом же макросе справа в обозревателе решений где все модули(Module1,2,3,4)или там есть чуть ниже Class Modules

@Апострофф · 17.11.2015, 14:53

Сообщение от Deimos_

Select Case DifferentDays
* * Case 28
* * * * For i = 0 To 28
* * * * * * SUM = Day + i
* * * * * * ActiveSheet.Range(sCopyAddress).AutoFilt er Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
* * * * Next i
* * Case 29
* * * * For i = 0 To 29
* * * * * * SUM = Day + i
* * * * * * ActiveSheet.Range(sCopyAddress).AutoFilt er Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
* * * * Next i
* * Case 30
* * * * For i = 0 To 30
* * * * * * SUM = Day + i
* * * * * * ActiveSheet.Range(sCopyAddress).AutoFilt er Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
* * * * Next i
* * Case 31
* * * * For i = 0 To 31
* * * * * * SUM = Day + i
* * * * * * ActiveSheet.Range(sCopyAddress).AutoFilt er Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
* * * * Next i
* * End Select

А так не получается?

Visual Basic
1
2
3
4
For i = 0 To DifferentDays
  SUM = Day + i
  ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
Next i

SoftIce · 17.11.2015, 14:57

Сообщение от Deimos_

А можно без вложенных стринговых переменных просто вызывать её?

Конечно, уберите из кавычек все параметры и все дела.

Разместить можно в том же модуле откуда будете вызывать, или сделать Public и разместить в другом, если будете вызывать из разных модулей.

@Deimos_ · 17.11.2015, 14:58 **[ТС]**

Еще как получается Спасибо ВСЕМ!

Вот результат вашей работы теперь все в функции висит и пишу только 1 строчку

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub CalculateDate()
Dim Day, Data, SerialDate As Date
Dim LastDay, SUM As Integer
Dim ILastRow, ILastCollumn As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ILastRow = Cells(Rows.Count, 1).End(xlUp).Row
    ILastCollumn = Cells(1, Columns.Count).End(xlToLeft).Column
    sCopyAddress = Range(Cells(2, 1), Cells(ILastRow, ILastCollumn)).Address
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Day = DateSerial(year(Data), month(Data), 1)
LastDay = DateSerial(year(Data), month(Data) + 1, 1) - 1
DifferentDays = DateDiff("d", Day, LastDay)
 
 For i = 0 To DifferentDays
   SUM = Day + i
   ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=SUM, Operator:=xlFilterValues
 Next i
 
End Sub

ОО какой кайф прийти от того говно кода который был и превратить в это

@pashulka · 18.11.2015, 16:52

Сообщение от Deimos_

SUM As Integer

Раз Integer это число в диапазоне от -32768 до 32767 , то получается, что максимально возможная дата - 16.09.1989 ... это нормально ?

P.S. Если нужно получить все даты определённого месяца, то раньше для этого цикл был не нужен :

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub FilterSelMonth()
    Dim iDate As Date, iMin As Date, iMax As Date
    Dim iLastRow As Long, iLastColumn As Long, iSource As Range
 
    iDate = Date 'Now '(для примера)
    iMin = DateSerial(Year(Date), Month(Date), 1)
    iMax = DateSerial(Year(Date), Month(Date) + 1, 0)
    
    iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    iLastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    Set iSource = Range(Cells(2, 1), Cells(iLastRow, iLastColumn))
 
    iSource.AutoFilter 6, ">=" & CDbl(iMin), xlAnd, "<=" & CDbl(iMax)
End Sub

@Deimos_ · 19.11.2015, 07:16 **[ТС]**

Да да видел что SUM это integer но кнопка Править уже исчезла и я несмог подправить код. Так и осталось.
Мне нужны были все дни определенного месяца в формате String потому что в фильтрах таблице через формат Date он не мог их включать в фильтр.
Поэтому я сделал вот так, и все заработало даже очень хорошо и удобно.Вопрос только быстрее этот код который у меня чем то что вы предложили выше.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Dim day As Date, LastDay As Date, Data As Date, SUM As Date
  Dim DifferentDays As Integer, i As Integer
  Dim MyArray() As String
    Data = Date
    day = DateSerial(year(Data), month(Data) - 1, 1)
    LastDay = DateSerial(year(Data), month(Data), 1) - 1
    DifferentDays = DateDiff("d", day, LastDay)
    ReDim MyArray(DifferentDays)
    For i = 0 To DifferentDays
        SUM = day + i
        MyArray(i) = SUM
    Next i
    ActiveSheet.Range(sCopyAddress).AutoFilter Field:=6, Criteria1:=Array(MyArray), Operator:=xlFilterValues

@Казанский · 19.11.2015, 16:07

Deimos_, формировать массив явно не быстрее. А вот вариант pashulka с меньшим кол-вом вызываемых функций

Visual Basic
1
2
3
4
5
    iDate = Date  '(для примера)
    iMin = iDate - Day(iDate) + 1
    iMax = DateAdd("m", 1, iMin) '1-е число след. м-ца
'...    
    iSource.AutoFilter 6, ">=" & CDbl(iMin), xlAnd, "<" & CDbl(iMax) 'строгое нер-во

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .
SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .	SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .	Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT bedvit 28.01.2026 Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .	SDL3 для Android: Загрузка PNG с альфа-каналом с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 28.01.2026 Содержание блога SDL3 имеет собственные средства для загрузки и отображения PNG-файлов с альфа-каналом и базовой работы с ними. В этой инструкции используется функция SDL_LoadPNG(), которая. . .

@Апострофф 9908 / 3924 / 742 Регистрация: 11.10.2011 Сообщений: 5,904
	17.11.2015, 13:15
	Определить количество дней в текущем месяце 1

@Deimos_ 39 / 38 / 32 Регистрация: 24.11.2014 Сообщений: 352
	17.11.2015, 14:51 [ТС]
	А можно без вложенных стринговых переменных просто вызывать её? И где этот код писать в этом же макросе справа в обозревателе решений где все модули(Module1,2,3,4)или там есть чуть ниже Class Modules 0

Оптимизация проверки дней в месяце

Решение