Извлечение данных из листа по дате

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Извлечение данных из листа по дате (Макросы/Sub)

Nova

Дата: Вторник, 07.02.2017, 23:20 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Добрый вечер, уважаемые форумчане!
Битый час сижу над файлом. Реализовать формулой могу, но боюсь, что в связи с увеличением массива это утяжелит работу файла.
Потому прошу поспособствовать в написании макроса, поскольку это дается мне очень тяжело.

Суть задачи: есть массив данных ключевой информацией в котором являются даты. Мне необходимо макросом перенести все данные таблицы на пустой лист по условию. Условие - вытащить все строки по которым дата равна до +30 дней от текущей включительно. То есть к примеру если сегодня 07.02.2017, мне необходима информация за месяц вперед.

Файл прилагаю, заранее благодарна!!!

К сообщению приложен файл: 3156070.xlsx (13.1 Kb)

Ответить

Nova

Дата: Вторник, 07.02.2017, 23:45 | Сообщение № 2

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Подскажите, на правильном ли я пути:
[vba]

Код

Sub bb()
Dim dat1 As Date ' Declare variables.
Dim dat2 As Range

dat1 = cell(c2)
dat2 = Range("c4:c8").Select
For DateDiff("d", dat1, dat2)<=60
Range("a20:D25").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
end for

End Sub

[/vba]

Сообщение отредактировал Pelena - Среда, 08.02.2017, 09:17

Ответить

KuklP

Дата: Среда, 08.02.2017, 00:32 | Сообщение № 3

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

Нет. Попробуйте, в модуль листа:
[vba]

Код

Public Sub www()
    Dim a, i&, j&, n&
    a = [a3].CurrentRegion.Value: n = 1
    For i = 2 To UBound(a)
        If a(i, 3) >= [C1] And a(i, 3) <= ([C1] + 30) Then
            n = n + 1
            For j = 1 To UBound(a, 2)
                a(n, j) = a(i, j)
            Next
        End If
    Next
    [j1].Resize(n, UBound(a, 2)) = a
End Sub

[/vba]