Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
Nidl
122 / 32 / 27
Регистрация: 22.02.2017
Сообщений: 234
1

Создать массив по возрастанию в диапазоне дат

14.10.2017, 15:46. Просмотров 821. Ответов 2
Метки нет (Все метки)

Доброго времени суток, имеется бесчисленный набор папок в котором есть файлы, имена папок - "01 Сентября 2017", "12 Октября 2017", "07 Февраля 2017" и т. д. Стоит задача создать массив для которого будут формироваться наименования папок по возрастанию в заданном диапазоне дат. Например массив из имен папок от "01 Сентября 2016" до "12 Октября 2017"

Пока смог сделать это, вроде все работает замечательно, даты по возрастанию по дню месяцу, году, но вот границы дней не смог прописать, было две идеи но разбились они как о скалы (

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
35
36
37
38
39
40
41
42
Sub search()
 
Dim arr
Dim arr0
Dim arr1
 
Dim a(0 To 1000) As String
Dim i As Integer
 
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
 
i = 0
 
arrMounth = Array("Января", "Февраля", "Марта", "Апреля", "Мая", "Июня", "Июля", "Августа", "Сентября", "Октября", "Ноября", "Декабря")
arr0 = Split("01 Января 2016", " ")
arr1 = Split("12 Октября 2018", " ")
 
For y = CLng(arr0(2)) To CLng(arr1(2))
    For m = 0 To 11
        For Each objSubFolder In objFolder.subfolders
            
            arr = Split(objSubFolder.Name, " ")
            
            If arr(2) = CStr(y) Then
                If arr(1) = arrMounth(m) Then
                    a(i) = objSubFolder.Path
                    i = i + 1
                End If
            End If
            
        Next objSubFolder
    Next m
Next y
 
MsgBox a(3)
 
End Sub
Добавлено через 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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Dim arr1
 
Dim a(0 To 1000) As String
Dim i As Integer
 
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
 
i = 0
 
arrMounth = Array("Января", "Февраля", "Марта", "Апреля", "Мая", "Июня", "Июля", "Августа", "Сентября", "Октября", "Ноября", "Декабря")
arrDay = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31")
arr0 = Split("01 Января 2016", " ")
arr1 = Split("12 Октября 2018", " ")
 
For y = CLng(arr0(2)) To CLng(arr1(2))
    For m = 0 To 11
        For d = 0 To 30
            For Each objSubFolder In objFolder.subfolders
            
                arr = Split(objSubFolder.Name, " ")
                
                If arr(2) = CStr(y) Then
                    If arr(1) = arrMounth(m) Then
                        If arr(0) = arrDay(d) Then
                            a(i) = objSubFolder.Path
                            i = i + 1
                        End If
                    End If
                End If
            
            Next objSubFolder
        Next d
    Next m
Next y
 
MsgBox i
 
End Sub
0
Лучшие ответы (1)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
14.10.2017, 15:46
Ответы с готовыми решениями:

Как сделать формулу, ответом которой будет несколько дат в диапазоне которых имеются значения 'И-2' ?
В первой строке идут даты по порядку начиная с 1.01.04 по 30.12.04 ниже идут...

Excel: создать новый массив по возрастанию элементов выделенного диапазона рабочей таблицы
Разработать подпрограмму создания нового массива по возрастанию элементов...

Расположить числа в диапазоне по возрастанию и закрасить ячейки, которые сдвигались
Дан диапазон чисел, знаков и букв. Требуется числа расположить в диапазоне по...

Интервал дат в массив
Друзья привет. Быстренко накатал небольшой код, который помогает вычесть 30...

Есть ли в VBA функция, позволяющая определить пересечение одного диапазона дат с другим диапазоном дат?
Привет Все! Задача такова: имеем 1 диапазон даты, например, 01.10.10-30.10.10...

2
Остап Бонд
734 / 468 / 227
Регистрация: 17.08.2017
Сообщений: 1,146
14.10.2017, 16:01 2
Лучший ответ Сообщение было отмечено Nidl как решение

Решение

Цитата Сообщение от Nidl Посмотреть сообщение
может быть есть более деликатный способ ?
Возможно
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Sub asd()
Dim a() As String, d1 As Date, d2 As Date, d As Date, c As Long
d1 = "01 Января 2016"
d2 = "12 Октября 2018"
For d = d1 To d2
  If Dir(ThisWorkbook.Path & "\" & Format$(d, "dd MMMM yyyy"), vbDirectory) <> "" Then
    ReDim Preserve a(c)
    a(c) = Format$(d, "dd mmmm yyyy")
    c = c + 1
  End If
Next
End Sub
1
Nidl
122 / 32 / 27
Регистрация: 22.02.2017
Сообщений: 234
14.10.2017, 18:31  [ТС] 3
Ваш пример работает мгновенно, мой вариант думает секунд 10, с ума сойти просто.

Спасибо Вам Большое
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
14.10.2017, 18:31

Когда пытась расчитать формулой разницу двух дат (формат дат) то получаю !ЗНАЧ сообщение об ошибке
hi all! Почему -то в excel когда пытась расчитать формулой разницу двух...

Подпрограмма, получает на входе одномерный массив дат
Помогите плиз в написание подпрограммы, которая получает на входе одномерный...

Массив: Отсортировать массив по возрастанию, используя While и If
Дан массив типа Array(50, 20, 80, 72, 60, 100, 25, 114, 10, 20) Нужно...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru