Подскажите пожалуйста, как в массиве данных посчитать минимальный интервал пустых ячеек, располагающихся между заполненными? Есть график отпусков, надо формулой определить у каждого человека минимальный промежуток между периодами отпуска. Эксперты, помогите пожалуйста, всю голову уже себе сломал.
Файл с примером прилагаю.
Была подобная тема, но там надо было подсчитать количество пустых ячеек между последними заполненными справа, мне же надо найти минимальный интервал http://www.excelworld.ru/forum/2-19672-1
Добрый день!
Подскажите пожалуйста, как в массиве данных посчитать минимальный интервал пустых ячеек, располагающихся между заполненными? Есть график отпусков, надо формулой определить у каждого человека минимальный промежуток между периодами отпуска. Эксперты, помогите пожалуйста, всю голову уже себе сломал.
Если процедурное решение (макрос) интересует, то у меня вот такое получилось, с довольно эффективным использованием Range.SpecialCells: [vba]
Код
Sub calcMinIntervals()
Dim rngSource As Range, rngTarget As Range Dim rngFilled As Range, rngEmpty As Range Dim cell1 As Range, cell2 As Range Dim rng As Range, area As Range Dim nMin As Integer
Set rngSource = Range("B5:AE8") 'матрица отпускных дней всех сотрудников Set rngTarget = Range("AH5:AH8") 'колонка результатов (для всех сотрудников)
For Each rng In rngSource.Rows 'цикл по строкам матрицы Set rngFilled = rng 'на случай если строка абсолютно пустая (без 1) On Error Resume Next Set rngFilled = rng.SpecialCells(xlCellTypeConstants, 23) On Error GoTo 0
Set cell1 = rngFilled.Cells(1, 1) Set cell2 = rngFilled.Areas(rngFilled.Areas.Count).Cells(1, 1)
Set rngEmpty = Range(cell1, cell2).SpecialCells(xlCellTypeBlanks) If Not rngEmpty Is Nothing And cell1.Address <> cell2.Address Then nMin = 1000 'заведомо большое число For Each area In rngEmpty.Areas nMin = WorksheetFunction.Min(nMin, area.Cells.Count) Next area Else nMin = 0 End If
rngTarget(rng.Row - rngSource.Row + 1) = nMin Next rng
End Sub
[/vba]
P.S. Но аналогичную пользовательскую функцию (UDF) по этим мотивам написать не смог! Точнее, написал, конечно, но она ни фига не хочет работать как надо - и именно SpecialCells
[vba]
Код
Function minInterval(rng As Range) 'НЕ РАБОТАЕТ !!! Из-за SpecialCells :(((
Dim rngFilled As Range, rngEmpty As Range Dim cell1 As Range, cell2 As Range Dim area As Range
Set rngFilled = rng.SpecialCells(xlCellTypeConstants, 23) Set cell1 = rngFilled.Cells(1, 1) Set cell2 = rngFilled.Areas(rngFilled.Areas.Count).Cells(1, 1)
Set rngEmpty = Range(cell1, cell2).SpecialCells(xlCellTypeBlanks) If rngEmpty Is Nothing Then minInterval = 0 Exit Function End If
minInterval = 1000 'заведомо большое число For Each area In rngEmpty.Areas minInterval = WorksheetFunction.Min(minInterval, area.Cells.Count) Next area
End Function
[/vba]
P.P.S. А вот и официальное подтверждение - SpecialCells не работает в UDF (ключевое уточнение - НА ЛИСТЕ!). Тут нашёл надпись английским по белому:
Цитата
SpecialCells does not work in UDFs. It's a limitation of Excel. Here's a list of things that don't work in UDFs.
Excel will not allow a UDF written in VBA to alter anything except the value of the cell in which it is entered. You cannot make a VBA UDF which directly: •Alters the value or formula or properties of another cell. •Alters the formatting of the cell in which it is entered. •Alters the environment of Excel. This includes the cursor. •Uses FIND, SpecialCells, CurrentRegion, CurrentArray, GOTO, SELECT, PRECEDENTS etc : although you can use Range.End. •Note you can use FIND in Excel 2002/2003.
И, оказывается, не только SpecialCells, но и любимый CurrentRegion невозможен. Про невозможность других знал и как-то даже интуитивно понятно, что никаких перемещений/выделений в функции быть не может. Но SpecialCells и CurrentRegion казались именно вычислительными методами, без каких-либо движений на листе. Ан нет, всё равно - низзя!
P.P.P.S. Еще раз акцентирую, что речь о неправильном (неожиданном) поведении SpecialCells в функциях, которые введены в формулы ячеек рабочего листа. Вне листа, возможно, что-то и работает. Во всяком случае я нашёл на форуме тему, в которой есть функция, содержащая SpecialCells и правильно работающая ВНЕ рабочего листа.
Если процедурное решение (макрос) интересует, то у меня вот такое получилось, с довольно эффективным использованием Range.SpecialCells: [vba]
Код
Sub calcMinIntervals()
Dim rngSource As Range, rngTarget As Range Dim rngFilled As Range, rngEmpty As Range Dim cell1 As Range, cell2 As Range Dim rng As Range, area As Range Dim nMin As Integer
Set rngSource = Range("B5:AE8") 'матрица отпускных дней всех сотрудников Set rngTarget = Range("AH5:AH8") 'колонка результатов (для всех сотрудников)
For Each rng In rngSource.Rows 'цикл по строкам матрицы Set rngFilled = rng 'на случай если строка абсолютно пустая (без 1) On Error Resume Next Set rngFilled = rng.SpecialCells(xlCellTypeConstants, 23) On Error GoTo 0
Set cell1 = rngFilled.Cells(1, 1) Set cell2 = rngFilled.Areas(rngFilled.Areas.Count).Cells(1, 1)
Set rngEmpty = Range(cell1, cell2).SpecialCells(xlCellTypeBlanks) If Not rngEmpty Is Nothing And cell1.Address <> cell2.Address Then nMin = 1000 'заведомо большое число For Each area In rngEmpty.Areas nMin = WorksheetFunction.Min(nMin, area.Cells.Count) Next area Else nMin = 0 End If
rngTarget(rng.Row - rngSource.Row + 1) = nMin Next rng
End Sub
[/vba]
P.S. Но аналогичную пользовательскую функцию (UDF) по этим мотивам написать не смог! Точнее, написал, конечно, но она ни фига не хочет работать как надо - и именно SpecialCells
[vba]
Код
Function minInterval(rng As Range) 'НЕ РАБОТАЕТ !!! Из-за SpecialCells :(((
Dim rngFilled As Range, rngEmpty As Range Dim cell1 As Range, cell2 As Range Dim area As Range
Set rngFilled = rng.SpecialCells(xlCellTypeConstants, 23) Set cell1 = rngFilled.Cells(1, 1) Set cell2 = rngFilled.Areas(rngFilled.Areas.Count).Cells(1, 1)
Set rngEmpty = Range(cell1, cell2).SpecialCells(xlCellTypeBlanks) If rngEmpty Is Nothing Then minInterval = 0 Exit Function End If
minInterval = 1000 'заведомо большое число For Each area In rngEmpty.Areas minInterval = WorksheetFunction.Min(minInterval, area.Cells.Count) Next area
End Function
[/vba]
P.P.S. А вот и официальное подтверждение - SpecialCells не работает в UDF (ключевое уточнение - НА ЛИСТЕ!). Тут нашёл надпись английским по белому:
Цитата
SpecialCells does not work in UDFs. It's a limitation of Excel. Here's a list of things that don't work in UDFs.
Excel will not allow a UDF written in VBA to alter anything except the value of the cell in which it is entered. You cannot make a VBA UDF which directly: •Alters the value or formula or properties of another cell. •Alters the formatting of the cell in which it is entered. •Alters the environment of Excel. This includes the cursor. •Uses FIND, SpecialCells, CurrentRegion, CurrentArray, GOTO, SELECT, PRECEDENTS etc : although you can use Range.End. •Note you can use FIND in Excel 2002/2003.
И, оказывается, не только SpecialCells, но и любимый CurrentRegion невозможен. Про невозможность других знал и как-то даже интуитивно понятно, что никаких перемещений/выделений в функции быть не может. Но SpecialCells и CurrentRegion казались именно вычислительными методами, без каких-либо движений на листе. Ан нет, всё равно - низзя!
P.P.P.S. Еще раз акцентирую, что речь о неправильном (неожиданном) поведении SpecialCells в функциях, которые введены в формулы ячеек рабочего листа. Вне листа, возможно, что-то и работает. Во всяком случае я нашёл на форуме тему, в которой есть функция, содержащая SpecialCells и правильно работающая ВНЕ рабочего листа.Gustav
Pelena, подскажите пожалуйста, длина обрабатываемого массива имеет значение? В маленькой табличке работает отлично, когда я вставляю в реальную таблицу на весь год формула почему-то начинает считать минимальный интервал с первой ячейки даже если введена всего одна единичка в строке. Либо я как-то криво умудрился заменить диапазон из Вашей формулы на реальный? Пример приложил, в табличке Лист 2.
Pelena, подскажите пожалуйста, длина обрабатываемого массива имеет значение? В маленькой табличке работает отлично, когда я вставляю в реальную таблицу на весь год формула почему-то начинает считать минимальный интервал с первой ячейки даже если введена всего одна единичка в строке. Либо я как-то криво умудрился заменить диапазон из Вашей формулы на реальный? Пример приложил, в табличке Лист 2.VichnyStudent
Добрый Второй аргумент ТЕКСТа очень похож на обычное форматирование ячейки для числовых форматов (кроме раскраски текста - в ТЕКСТ она не работает) ЧислоБольшеНуля; ЧислоМеньшеНуля; Ноль; Текст Получаем для положительных чисел выводятся сами числа, для отрицательных и нулей -выводится 999
Добрый Второй аргумент ТЕКСТа очень похож на обычное форматирование ячейки для числовых форматов (кроме раскраски текста - в ТЕКСТ она не работает) ЧислоБольшеНуля; ЧислоМеньшеНуля; Ноль; Текст Получаем для положительных чисел выводятся сами числа, для отрицательных и нулей -выводится 999
Pelena, я извиняюсь за назойливость, но можно ещё один вопрос: как заставить работать формулу если единички в клетки подставляются как результат функции "если" как в приложенном примере? Вариант _Boroda_ тоже не работает
Pelena, я извиняюсь за назойливость, но можно ещё один вопрос: как заставить работать формулу если единички в клетки подставляются как результат функции "если" как в приложенном примере? Вариант _Boroda_ тоже не работает VichnyStudent
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
[/offtop]
