Добрый день! Подскажите с формулой или как можно решить проблему, не смог найти на форуме! Есть ведомость тестирования, в ведомости 10 вопросов, за правильный ответ проставляется "+" за неправильный "-". НО необходимо сделать чтобы по выставлении оценки "5,4,3,2" "+" и "-" проставлялись в ячейки в рандомном порядке но при условии что "5" - это 9-10 правильных ответов т.е. "+", "4" - это 8 "+", "3" - 7 "+" и "2" если меньше 7 правильных ответов!
Добрый день! Подскажите с формулой или как можно решить проблему, не смог найти на форуме! Есть ведомость тестирования, в ведомости 10 вопросов, за правильный ответ проставляется "+" за неправильный "-". НО необходимо сделать чтобы по выставлении оценки "5,4,3,2" "+" и "-" проставлялись в ячейки в рандомном порядке но при условии что "5" - это 9-10 правильных ответов т.е. "+", "4" - это 8 "+", "3" - 7 "+" и "2" если меньше 7 правильных ответов!Eldar7513
Nic70y, я наверно неправильно выразился! вместо формулы в ячейку O8 оценка за теоретическую подготовку нужно поставить оценку, например 4 и после этого в ячейки E8:N8 автоматически должны проставится в рандомном порядке + и - т.е. 8 + и 2 -
Nic70y, я наверно неправильно выразился! вместо формулы в ячейку O8 оценка за теоретическую подготовку нужно поставить оценку, например 4 и после этого в ячейки E8:N8 автоматически должны проставится в рандомном порядке + и - т.е. 8 + и 2 -Eldar7513
Sub u_148() Application.ScreenUpdating = False u = Cells(Rows.Count, "o").End(xlUp).Row If u > 7 Then Range("e8:n" & u).ClearContents For v = 8 To u a = Range("o" & v).Value '2 If a = 2 Then b = WorksheetFunction.RandBetween(4, 10) For f = 0 To b - 1 c = WorksheetFunction.RandBetween(1, 10 - f) e = 0 For Each d In Range("e" & v & ":n" & v).SpecialCells(xlCellTypeBlanks) e = e + 1 If e = c Then d.Value = "-" Exit For End If Next Next End If '3 If a = 3 Then b = WorksheetFunction.RandBetween(5, 14) Cells(v, b) = "-" For f = 0 To 1 c = WorksheetFunction.RandBetween(1, 9 - f) e = 0 For Each d In Range("e" & v & ":n" & v).SpecialCells(xlCellTypeBlanks) e = e + 1 If e = c Then d.Value = "-" Exit For End If Next Next End If '4 If a = 4 Then b = WorksheetFunction.RandBetween(5, 14) Cells(v, b) = "-" c = WorksheetFunction.RandBetween(1, 9) e = 0 For Each d In Range("e" & v & ":n" & v).SpecialCells(xlCellTypeBlanks) e = e + 1 If e = c Then d.Value = "-" Exit For End If Next End If '5 If a = 5 Then b = WorksheetFunction.RandBetween(1, 15) If b < 11 Then Cells(v, b + 4) = "-" End If Next Range("e8:n" & u).SpecialCells(xlCellTypeBlanks) = "+" Application.ScreenUpdating = True End Sub
[/vba]вдруг правильно
сократил [vba]
Код
Sub u_315() Application.ScreenUpdating = False a = Array(2, 2, 2, 2, 2, 2, 2, 3, 4, 5, 5) i = Array(10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0) b = Cells(Rows.Count, "o").End(xlUp).Row If b > 7 Then Range("e8:n" & b).ClearContents For c = 8 To b d = Range("o" & c).Value e = Application.Match(d, a, 0) f = Application.Match(d, a, 1) g = Application.RandBetween(e, f) k = i(g - 1) If k > 0 Then For l = 1 To k m = Application.RandBetween(1, 10 - l + 1) f = 0 For Each q In Range("e" & c & ":n" & c).SpecialCells(xlCellTypeBlanks) f = f + 1 If m = f Then q.Value = "-" Exit For End If Next Next End If Next Range("e8:n" & b).SpecialCells(xlCellTypeBlanks) = "+" Application.ScreenUpdating = True End Sub
[/vba]
Eldar7513, макрос
[vba]
Код
Sub u_148() Application.ScreenUpdating = False u = Cells(Rows.Count, "o").End(xlUp).Row If u > 7 Then Range("e8:n" & u).ClearContents For v = 8 To u a = Range("o" & v).Value '2 If a = 2 Then b = WorksheetFunction.RandBetween(4, 10) For f = 0 To b - 1 c = WorksheetFunction.RandBetween(1, 10 - f) e = 0 For Each d In Range("e" & v & ":n" & v).SpecialCells(xlCellTypeBlanks) e = e + 1 If e = c Then d.Value = "-" Exit For End If Next Next End If '3 If a = 3 Then b = WorksheetFunction.RandBetween(5, 14) Cells(v, b) = "-" For f = 0 To 1 c = WorksheetFunction.RandBetween(1, 9 - f) e = 0 For Each d In Range("e" & v & ":n" & v).SpecialCells(xlCellTypeBlanks) e = e + 1 If e = c Then d.Value = "-" Exit For End If Next Next End If '4 If a = 4 Then b = WorksheetFunction.RandBetween(5, 14) Cells(v, b) = "-" c = WorksheetFunction.RandBetween(1, 9) e = 0 For Each d In Range("e" & v & ":n" & v).SpecialCells(xlCellTypeBlanks) e = e + 1 If e = c Then d.Value = "-" Exit For End If Next End If '5 If a = 5 Then b = WorksheetFunction.RandBetween(1, 15) If b < 11 Then Cells(v, b + 4) = "-" End If Next Range("e8:n" & u).SpecialCells(xlCellTypeBlanks) = "+" Application.ScreenUpdating = True End Sub
[/vba]вдруг правильно
сократил [vba]
Код
Sub u_315() Application.ScreenUpdating = False a = Array(2, 2, 2, 2, 2, 2, 2, 3, 4, 5, 5) i = Array(10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0) b = Cells(Rows.Count, "o").End(xlUp).Row If b > 7 Then Range("e8:n" & b).ClearContents For c = 8 To b d = Range("o" & c).Value e = Application.Match(d, a, 0) f = Application.Match(d, a, 1) g = Application.RandBetween(e, f) k = i(g - 1) If k > 0 Then For l = 1 To k m = Application.RandBetween(1, 10 - l + 1) f = 0 For Each q In Range("e" & c & ":n" & c).SpecialCells(xlCellTypeBlanks) f = f + 1 If m = f Then q.Value = "-" Exit For End If Next Next End If Next Range("e8:n" & b).SpecialCells(xlCellTypeBlanks) = "+" Application.ScreenUpdating = True End Sub
Попробовал формулами, так побаловаться Почти получилось, единственное - не удается установить минимальное количество "-", от чего тройка и двойка могут оказаться с недостаточным их количеством, теоретически и четверка, но это маловероятно. В общем решение не готовое, но может логика действий как-то подтолкнет к чему-то)))
Попробовал формулами, так побаловаться Почти получилось, единственное - не удается установить минимальное количество "-", от чего тройка и двойка могут оказаться с недостаточным их количеством, теоретически и четверка, но это маловероятно. В общем решение не готовое, но может логика действий как-то подтолкнет к чему-то)))elovkov
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
