Добрый день, коллеги! Помогите в написании функции / формулы для гидравлического расчета пожаротушения. Смысл расчета - проектировщик пишет - нумерацию насадков, участвующие на данном участке , например "1-5, 7-10, 25", то программа должна АВТОМАТИЧЕСКИ заполнить в каждом ячейке одного столбца перечень насадков , например в данном случае "1,2,3,4,5,7,8,9,10,25" Спасибо
Добрый день, коллеги! Помогите в написании функции / формулы для гидравлического расчета пожаротушения. Смысл расчета - проектировщик пишет - нумерацию насадков, участвующие на данном участке , например "1-5, 7-10, 25", то программа должна АВТОМАТИЧЕСКИ заполнить в каждом ячейке одного столбца перечень насадков , например в данном случае "1,2,3,4,5,7,8,9,10,25" СпасибоBlackJek
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row <> 4 Then Exit Sub ic = Target.Column If ic < 8 Or ic > 10 Then Exit Sub irow = 8 Range(Cells(8, ic), Cells(19, ic)).ClearContents s = Split(Replace(Target.Value, " ", ""), ",") For x = 0 To UBound(s) pp = InStr(1, s(x), "-") If pp Then ifirst = Left(s(x), pp - 1) y = -Evaluate(s(x)) For ir = irow To irow + y Cells(ir, ic).Value = ifirst irow = irow + 1 ifirst = ifirst + 1 Next ir Else Cells(irow, ic).Value = s(x) irow = irow + 1 End If Next x End Sub
[/vba]
Добрый день. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row <> 4 Then Exit Sub ic = Target.Column If ic < 8 Or ic > 10 Then Exit Sub irow = 8 Range(Cells(8, ic), Cells(19, ic)).ClearContents s = Split(Replace(Target.Value, " ", ""), ",") For x = 0 To UBound(s) pp = InStr(1, s(x), "-") If pp Then ifirst = Left(s(x), pp - 1) y = -Evaluate(s(x)) For ir = irow To irow + y Cells(ir, ic).Value = ifirst irow = irow + 1 ifirst = ifirst + 1 Next ir Else Cells(irow, ic).Value = s(x) irow = irow + 1 End If Next x End Sub
Работает! Спасибо! Но есть одно НО . Можно ли сделать количество вводимых ячеек, например до 40? А то сейчас в данном случае - до 12 ячеек контролируется. Например вводишь 1-14 , программа заполняет ячейки от 1 до 14, а когда начинаешь исправлять вводимую ячейку, т.е. написать другое число , то стирается с 1 по 12, а 13,14 остаются на таблице. Спасибо
Работает! Спасибо! Но есть одно НО . Можно ли сделать количество вводимых ячеек, например до 40? А то сейчас в данном случае - до 12 ячеек контролируется. Например вводишь 1-14 , программа заполняет ячейки от 1 до 14, а когда начинаешь исправлять вводимую ячейку, т.е. написать другое число , то стирается с 1 по 12, а 13,14 остаются на таблице. СпасибоBlackJek
Function BlackJek(iStr As String, N As Long) Dim t As Long, i As Long, j As Long Dim a, b t = 1 a = Split(Replace(iStr, " ", ""), ",") For i = 0 To UBound(a) If InStr(a(i), "-") > 0 Then b = Split(a(i), "-") For j = b(0) To b(1) If t = N Then BlackJek = j: Exit Function t = t + 1 Next j Else If t = N Then BlackJek = Int(a(i)): Exit Function t = t + 1 End If Next i BlackJek = "" End Function
[/vba]
Вариант с функцией пользователя.[vba]
Код
Function BlackJek(iStr As String, N As Long) Dim t As Long, i As Long, j As Long Dim a, b t = 1 a = Split(Replace(iStr, " ", ""), ",") For i = 0 To UBound(a) If InStr(a(i), "-") > 0 Then b = Split(a(i), "-") For j = b(0) To b(1) If t = N Then BlackJek = j: Exit Function t = t + 1 Next j Else If t = N Then BlackJek = Int(a(i)): Exit Function t = t + 1 End If Next i BlackJek = "" End Function
Добрый день, Коллеги! sboy, AlexM спасибо за помощь! Все вроде верно, близко , но чуть чуть не то. Извините , что Вас немного напряг. Вот скидываю файл - думаю там понятно будет!
sboy - у Вас совсем близко! Но почему я не могу ввести 1-40 (сообщает "Количество больше 40"), и дает возможность ввести повторяющие числа ..
Добрый день, Коллеги! sboy, AlexM спасибо за помощь! Все вроде верно, близко , но чуть чуть не то. Извините , что Вас немного напряг. Вот скидываю файл - думаю там понятно будет!
sboy - у Вас совсем близко! Но почему я не могу ввести 1-40 (сообщает "Количество больше 40"), и дает возможность ввести повторяющие числа ..BlackJek
об этом нигде сказано не было, бабы Ванги на другом форуме собираются! Добавил
Цитата
Т.е. 41, 42 оросителя нет!
вот тут снова не понял, нет по номеру или количеству. Оставил по количеству. Проверяйте
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row <> 4 Then Exit Sub ic = Target.Column If ic < 8 Or ic > 70 Then Exit Sub result = "" Range(Cells(10, ic), Cells(49, ic)).ClearContents s = Split(Replace(Target.Value, " ", ""), ",") For x = 0 To UBound(s) pp = InStr(1, s(x), "-") If pp Then ifirst = Left(s(x), pp - 1) y = -Evaluate(s(x)) + 1 For ir = 1 To y result = result & ifirst & "," ifirst = ifirst + 1 Next ir Else result = result & s(x) & "," End If Next x
result = WorksheetFunction.Transpose(Split(result, ",")) If UBound(result) > 41 Then MsgBox "Количество больше 40!" Exit Sub End If For q = 1 To UBound(result) For qq = 1 To UBound(result) If q <> qq Then If result(q, 1) = result(qq, 1) Then MsgBox "Введены повторяющиеся значения!" Exit Sub End If End If Next qq Next q
Range(Cells(10, ic), Cells(10, ic).Offset(UBound(result) - 1, 0)) = result
об этом нигде сказано не было, бабы Ванги на другом форуме собираются! Добавил
Цитата
Т.е. 41, 42 оросителя нет!
вот тут снова не понял, нет по номеру или количеству. Оставил по количеству. Проверяйте
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row <> 4 Then Exit Sub ic = Target.Column If ic < 8 Or ic > 70 Then Exit Sub result = "" Range(Cells(10, ic), Cells(49, ic)).ClearContents s = Split(Replace(Target.Value, " ", ""), ",") For x = 0 To UBound(s) pp = InStr(1, s(x), "-") If pp Then ifirst = Left(s(x), pp - 1) y = -Evaluate(s(x)) + 1 For ir = 1 To y result = result & ifirst & "," ifirst = ifirst + 1 Next ir Else result = result & s(x) & "," End If Next x
result = WorksheetFunction.Transpose(Split(result, ",")) If UBound(result) > 41 Then MsgBox "Количество больше 40!" Exit Sub End If For q = 1 To UBound(result) For qq = 1 To UBound(result) If q <> qq Then If result(q, 1) = result(qq, 1) Then MsgBox "Введены повторяющиеся значения!" Exit Sub End If End If Next qq Next q
Range(Cells(10, ic), Cells(10, ic).Offset(UBound(result) - 1, 0)) = result
Насколько я понимаю, надо делать еще проверку на корректность ввода текстовой строки, в которой числа и диапазоны чисел. Надо проверять следующие моменты. 1. число или граница диапазона была не более 40 2. число не было равно любой границе диапазона. 3. число не должно попадать в диапазон 4. числа и диапазоны не должны повторяться. 5. диапазоны не должны пересекаться.
Возможно ли это сделать. Возможно. Как представляю. Создать массив из всех отдельных чисел и чисел входящих в диапазоны. Из полученного массива убрать повторы, т.е. сделать массив уникальных чисел и сделать сортировку по возрастанию. Из массива уникальных чисел сформировать текстовую строку, по подобию той, что пишет оператор. Сравнить строку написанную оператором и полученную. Если не совпадают, сообщить об ошибке ввода. Если ошибок нет. Очистить столбец ниже и затем заполнить его значениями массива.
Мне кажется, что объем задачи большой, выходит за рамки хобби. Это уже работа.
Насколько я понимаю, надо делать еще проверку на корректность ввода текстовой строки, в которой числа и диапазоны чисел. Надо проверять следующие моменты. 1. число или граница диапазона была не более 40 2. число не было равно любой границе диапазона. 3. число не должно попадать в диапазон 4. числа и диапазоны не должны повторяться. 5. диапазоны не должны пересекаться.
Возможно ли это сделать. Возможно. Как представляю. Создать массив из всех отдельных чисел и чисел входящих в диапазоны. Из полученного массива убрать повторы, т.е. сделать массив уникальных чисел и сделать сортировку по возрастанию. Из массива уникальных чисел сформировать текстовую строку, по подобию той, что пишет оператор. Сравнить строку написанную оператором и полученную. Если не совпадают, сообщить об ошибке ввода. Если ошибок нет. Очистить столбец ниже и затем заполнить его значениями массива.
Мне кажется, что объем задачи большой, выходит за рамки хобби. Это уже работа.AlexM
Номер мобильного модема (без голосовой связи) 9269171249 МегаФон, Московский регион.
Сообщение отредактировал AlexM - Вторник, 06.06.2017, 12:41
Цитата BlackJek, 06.06.2017 в 11:58, в сообщении № 12 ( писал(а)): дает возможность ввести повторяющие числа об этом нигде сказано не было, бабы Ванги на другом форуме собираются! Добавил
Цитата BlackJek, 06.06.2017 в 11:58, в сообщении № 12 ( писал(а)): дает возможность ввести повторяющие числа об этом нигде сказано не было, бабы Ванги на другом форуме собираются! Добавил
Сергей Спасибо тебе огромное! Хотелось добавить - а можно сделать запрет на ноль. И когда на ячейке , где мы пишем значения нажимаем "DELETE" выскакивает ошибка программы
Сергей Спасибо тебе огромное! Хотелось добавить - а можно сделать запрет на ноль. И когда на ячейке , где мы пишем значения нажимаем "DELETE" выскакивает ошибка программыBlackJek
Хотелось добавить - а можно сделать запрет на ноль
может уже выложите все пожелания-ограничения, а то напоминает сказку про золотую рыбку) Вангую: следующим будет ограничение на отрицательные числа, угадал?
Хотелось добавить - а можно сделать запрет на ноль
может уже выложите все пожелания-ограничения, а то напоминает сказку про золотую рыбку) Вангую: следующим будет ограничение на отрицательные числа, угадал?