Доброго времени суток, прошу помочь создать проверку даты на дни исключения из списка. Чтобы, если дата в ячейке F3 будет равна дате из столбца O, то дата в ячейке F3 менялась на следующий день и снова происходила проверка, до тех пор пока не будет дата, которой нет в списке. Например: в ячейке F3 стоит дата 07.01.2017, то при нажатии на кнопку происходит проверка по этому списку и если дата совпадает, то он добавляет к дате в ячейке F3 еще один день (08.01.2017) и опять проводит проверку, если день опять совпадает, то переводит дату ещё на один день вперед (09.01.2017).
Доброго времени суток, прошу помочь создать проверку даты на дни исключения из списка. Чтобы, если дата в ячейке F3 будет равна дате из столбца O, то дата в ячейке F3 менялась на следующий день и снова происходила проверка, до тех пор пока не будет дата, которой нет в списке. Например: в ячейке F3 стоит дата 07.01.2017, то при нажатии на кнопку происходит проверка по этому списку и если дата совпадает, то он добавляет к дате в ячейке F3 еще один день (08.01.2017) и опять проводит проверку, если день опять совпадает, то переводит дату ещё на один день вперед (09.01.2017).aghient
Sub ttt() Dim dt As Date, i&, x dt = CStr(Range("F3").Value)
On Error Resume Next: Err.Clear With WorksheetFunction x = .Transpose(Range("O3", Cells(Rows.Count, "O").End(xlUp)).Value) Do i = .Match(CStr(dt), x, 0) If Err Then Exit Do dt = dt + 1 Loop End With Range("F3").Value = dt End Sub
[/vba]
Здравствуйте попробуйте так [vba]
Код
Sub ttt() Dim dt As Date, i&, x dt = CStr(Range("F3").Value)
On Error Resume Next: Err.Clear With WorksheetFunction x = .Transpose(Range("O3", Cells(Rows.Count, "O").End(xlUp)).Value) Do i = .Match(CStr(dt), x, 0) If Err Then Exit Do dt = dt + 1 Loop End With Range("F3").Value = dt End Sub
Sub ttt() Dim dt As Date, x, a dt = CStr(Range("F3").Value) x = Application.Transpose([O2].CurrentRegion.Value) Do a = Filter(x, dt) If UBound(a) >= 0 Then dt = dt + 1 Else Exit Do Loop Range("F3").Value = dt End Sub
[/vba]
Попаразитировал на коде Николая: [vba]
Код
Sub ttt() Dim dt As Date, x, a dt = CStr(Range("F3").Value) x = Application.Transpose([O2].CurrentRegion.Value) Do a = Filter(x, dt) If UBound(a) >= 0 Then dt = dt + 1 Else Exit Do Loop Range("F3").Value = dt End Sub
Sub tt() With Range("F3") d_ = CLng(.Value) .FormulaArray = "=" & d_ & "+MATCH(1=1,ISNA(MATCH(" & d_ & "+ROW(R1:R20),R3C15:R25C15,)),)" .Value = .Value End With End Sub
Sub tt() With Range("F3") d_ = CLng(.Value) .FormulaArray = "=" & d_ & "+MATCH(1=1,ISNA(MATCH(" & d_ & "+ROW(R1:R20),R3C15:R25C15,)),)" .Value = .Value End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
