помогите с VBA
Started By JoBzik, июн 11 2008 13:24
15 ответов в этой теме
#1
Отправлено 11 июня 2008 - 13:24
помогите создать программу, которая из заданных 10 чисел выдавала бы все варианты по 6 чисел.
например:
1 2 3 4 5 6 7 8 9 10
1 2 3 4 5 6
1 2 3 4 5 7
1 2 3 4 5 8
1 2 3 4 5 9
1 2 3 4 5 10
2 3 4 5 6 7
..........ИТД
пишите сюда или на [email protected]
спасибо
например:
1 2 3 4 5 6 7 8 9 10
1 2 3 4 5 6
1 2 3 4 5 7
1 2 3 4 5 8
1 2 3 4 5 9
1 2 3 4 5 10
2 3 4 5 6 7
..........ИТД
пишите сюда или на [email protected]
спасибо
Смерть стоит того, чтобы жить,
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)
#2
Отправлено 13 июня 2008 - 07:17
JoBzik, и что же сложного мы тут видим? Простой перебор по алфавиту ...
Проще всего это сделать так ...
Алфавит 0 ... 9 (1-10 в твоем случаем)
То есть у нас обычная десятиричная система исчисления .... то есть наша задача прокрутить счетчик от 1 0 0 0 0 0 до 9 9 9 9 9 9 ... и всё
Проще всего это сделать так ...
Алфавит 0 ... 9 (1-10 в твоем случаем)
То есть у нас обычная десятиричная система исчисления .... то есть наша задача прокрутить счетчик от 1 0 0 0 0 0 до 9 9 9 9 9 9 ... и всё
Victoria nulla est, Quam quae confessos animo quoque subjugat hostes ...
Верю в смерть после жизни, любовь после секса и в крем после бритья ...
Верю в смерть после жизни, любовь после секса и в крем после бритья ...
#6
Отправлено 13 июня 2008 - 08:18
Slаm, ну а ему что надо ... все варианты по 6-ть чисел? то есть перебор всего алфавита ... где длина будет равна 6-и.
ЗЫ! Или я чего-то не понимаю
Хорошо ... мы программисты - народ ленивый ... переделаем предыдущий вариант до устраивающего нас ... получится что-то вроде
Это предыдущий вариант ... который переберает всё
ЗЫ! Специально допущена маленькая ошибка (неверно заданы интервали) ... но это так чтобы жизнь- медом не казалась ))
А можно расмотреть всё под другим углом ... за алфавит взять позиции, а алфовит за позиции ... и тогда это будет таким же решением ... но без извратов. Всё очень просто
ЗЫ! Тут главное не опухнуть
ЗЫ! Или я чего-то не понимаю
Хорошо ... мы программисты - народ ленивый ... переделаем предыдущий вариант до устраивающего нас ... получится что-то вроде
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> <html> <head> <title>Combinatorica</title> <script> var alphabet = [1,2,3,4,5,6,7,8,9,10]; function comb(out) { for(var i = 100000;i < 1000000;i++) { var z = new String(i); var s = ""; var k = [0,0,0,0,0,0,0,0,0,0]; var b = false; for(var j = 0; j < z.length; j++) { if (k[z.charAt(j)] > 0) { b = true; break; } else k[z.charAt(j)] += 1; s += " " + alphabet[z.charAt(j)]; } if (!b) document.write(s + "<br>"); } } </script> </head> <body> Понеслася :)))) <span id="output" style="width:100%"></span> <input type="button" value="calculate" onclick="comb(document.getElementById('output'));return false;"> </body> </html>
Это предыдущий вариант ... который переберает всё
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> <html> <head> <title>Combinatorica</title> <script> var alphabet = [1,2,3,4,5,6,7,8,9,10]; function comb(out) { for(var i = 100000;i < 1000000;i++) { var z = new String(i); var s = ""; for(var j = 0; j < z.length; j++) { s += " " + alphabet[z.charAt(j)]; } document.write(s + "<br>"); } } </script> </head> <body> Понеслася :))) <span id="output" style="width:100%"></span> <input type="button" value="calculate" onclick="comb(document.getElementById('output'));return false;"> </body> </html>
ЗЫ! Специально допущена маленькая ошибка (неверно заданы интервали) ... но это так чтобы жизнь- медом не казалась ))
А можно расмотреть всё под другим углом ... за алфавит взять позиции, а алфовит за позиции ... и тогда это будет таким же решением ... но без извратов. Всё очень просто
ЗЫ! Тут главное не опухнуть
Victoria nulla est, Quam quae confessos animo quoque subjugat hostes ...
Верю в смерть после жизни, любовь после секса и в крем после бритья ...
Верю в смерть после жизни, любовь после секса и в крем после бритья ...
#9
Отправлено 01 июля 2008 - 22:02
Incubo, спасибо за помощь
итоговый код в VBA
итоговый код в VBA
Sub proga1() r = 1 i = 1 u = 1 v = 1 Z = 1 j = 1 For a = 1 To 5 For b = a + 1 To a + 5 If b > 10 Then Exit For For c = b + 1 To b + 5 If c > 10 Then Exit For For d = c + 1 To c + 5 If d > 10 Then Exit For For e = d + 1 To d + 5 If e > 10 Then Exit For For f = e + 1 To e + 5 If f > 10 Then Exit For Cells(r, 1) = a r = r + 1 Cells(i, 2) = b i = i + 1 Cells(u, 3) = c u = u + 1 Cells(v, 4) = c v = v + 1 Cells(Z, 5) = e Z = Z + 1 Cells(j, 6) = f j = j + 1 Next Next Next Next Next Next End Sub
Смерть стоит того, чтобы жить,
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)
#10
Отправлено 05 июля 2008 - 11:25
Не, то что ты написал работать не будет!
уже даже первая строчка будет :
123356
Что противоречит условиям задачи. Как собственно и все строчки неверны так как в них попадаются дубликаты.
И во вторых у тебя перебор длится только до
5677910
Если конечно я правильно понял алгоритм (а мне кажется я понял его правильно)
уже даже первая строчка будет :
123356
Что противоречит условиям задачи. Как собственно и все строчки неверны так как в них попадаются дубликаты.
И во вторых у тебя перебор длится только до
5677910
Если конечно я правильно понял алгоритм (а мне кажется я понял его правильно)
Victoria nulla est, Quam quae confessos animo quoque subjugat hostes ...
Верю в смерть после жизни, любовь после секса и в крем после бритья ...
Верю в смерть после жизни, любовь после секса и в крем после бритья ...
#11
Отправлено 05 июля 2008 - 20:25
извиняюсь... маленькая опечатка..... вот итоговый вариант
Sub proga1() r = 1 i = 1 u = 1 v = 1 Z = 1 j = 1 For a = 1 To 5 For b = a + 1 To a + 5 If b > 10 Then Exit For For c = b + 1 To b + 5 If c > 10 Then Exit For For d = c + 1 To c + 5 If d > 10 Then Exit For For e = d + 1 To d + 5 If e > 10 Then Exit For For f = e + 1 To e + 5 If f > 10 Then Exit For Cells(r, 1) = a r = r + 1 Cells(i, 2) = b i = i + 1 Cells(u, 3) = c u = u + 1 Cells(v, 4) = c v = v + 1 Cells(Z, 5) = e Z = Z + 1 Cells(j, 6) = f j = j + 1 Next Next Next Next Next Next End Sub
Смерть стоит того, чтобы жить,
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)
#12
Отправлено 05 июля 2008 - 20:34
Всё равно ... смотри какой ответ выдает твоя процедура
Т.е. ни одна из строчек не удовлетворяет условиям задачи.
Я же тебе показал как сделать. Напиши по аналогии только на VBA
1 2 3 3 5 6 1 2 3 3 5 7 1 2 3 3 5 8 1 2 3 3 5 9 1 2 3 3 5 10 1 2 3 3 6 7 1 2 3 3 6 8 1 2 3 3 6 9 1 2 3 3 6 10 1 2 3 3 7 8 1 2 3 3 7 9 1 2 3 3 7 10 1 2 3 3 8 9 1 2 3 3 8 10 1 2 3 3 9 10 1 2 3 3 6 7 1 2 3 3 6 8 1 2 3 3 6 9 1 2 3 3 6 10 1 2 3 3 7 8 1 2 3 3 7 9 1 2 3 3 7 10 1 2 3 3 8 9 1 2 3 3 8 10 1 2 3 3 9 10 1 2 3 3 7 8 1 2 3 3 7 9 1 2 3 3 7 10 1 2 3 3 8 9 1 2 3 3 8 10 1 2 3 3 9 10 1 2 3 3 8 9 1 2 3 3 8 10 1 2 3 3 9 10 1 2 3 3 9 10 1 2 4 4 6 7 1 2 4 4 6 8 1 2 4 4 6 9 1 2 4 4 6 10 1 2 4 4 7 8 1 2 4 4 7 9 1 2 4 4 7 10 1 2 4 4 8 9 1 2 4 4 8 10 1 2 4 4 9 10 1 2 4 4 7 8 1 2 4 4 7 9 1 2 4 4 7 10 1 2 4 4 8 9 1 2 4 4 8 10 1 2 4 4 9 10 1 2 4 4 8 9 1 2 4 4 8 10 1 2 4 4 9 10 1 2 4 4 9 10 1 2 5 5 7 8 1 2 5 5 7 9 1 2 5 5 7 10 1 2 5 5 8 9 1 2 5 5 8 10 1 2 5 5 9 10 1 2 5 5 8 9 1 2 5 5 8 10 1 2 5 5 9 10 1 2 5 5 9 10 1 2 6 6 8 9 1 2 6 6 8 10 1 2 6 6 9 10 1 2 6 6 9 10 1 2 7 7 9 10 1 3 4 4 6 7 1 3 4 4 6 8 1 3 4 4 6 9 1 3 4 4 6 10 1 3 4 4 7 8 1 3 4 4 7 9 1 3 4 4 7 10 1 3 4 4 8 9 1 3 4 4 8 10 1 3 4 4 9 10 1 3 4 4 7 8 1 3 4 4 7 9 1 3 4 4 7 10 1 3 4 4 8 9 1 3 4 4 8 10 1 3 4 4 9 10 1 3 4 4 8 9 1 3 4 4 8 10 1 3 4 4 9 10 1 3 4 4 9 10 1 3 5 5 7 8 1 3 5 5 7 9 1 3 5 5 7 10 1 3 5 5 8 9 1 3 5 5 8 10 1 3 5 5 9 10 1 3 5 5 8 9 1 3 5 5 8 10 1 3 5 5 9 10 1 3 5 5 9 10 1 3 6 6 8 9 1 3 6 6 8 10 1 3 6 6 9 10 1 3 6 6 9 10 1 3 7 7 9 10 1 4 5 5 7 8 1 4 5 5 7 9 1 4 5 5 7 10 1 4 5 5 8 9 1 4 5 5 8 10 1 4 5 5 9 10 1 4 5 5 8 9 1 4 5 5 8 10 1 4 5 5 9 10 1 4 5 5 9 10 1 4 6 6 8 9 1 4 6 6 8 10 1 4 6 6 9 10 1 4 6 6 9 10 1 4 7 7 9 10 1 5 6 6 8 9 1 5 6 6 8 10 1 5 6 6 9 10 1 5 6 6 9 10 1 5 7 7 9 10 1 6 7 7 9 10 2 3 4 4 6 7 2 3 4 4 6 8 2 3 4 4 6 9 2 3 4 4 6 10 2 3 4 4 7 8 2 3 4 4 7 9 2 3 4 4 7 10 2 3 4 4 8 9 2 3 4 4 8 10 2 3 4 4 9 10 2 3 4 4 7 8 2 3 4 4 7 9 2 3 4 4 7 10 2 3 4 4 8 9 2 3 4 4 8 10 2 3 4 4 9 10 2 3 4 4 8 9 2 3 4 4 8 10 2 3 4 4 9 10 2 3 4 4 9 10 2 3 5 5 7 8 2 3 5 5 7 9 2 3 5 5 7 10 2 3 5 5 8 9 2 3 5 5 8 10 2 3 5 5 9 10 2 3 5 5 8 9 2 3 5 5 8 10 2 3 5 5 9 10 2 3 5 5 9 10 2 3 6 6 8 9 2 3 6 6 8 10 2 3 6 6 9 10 2 3 6 6 9 10 2 3 7 7 9 10 2 4 5 5 7 8 2 4 5 5 7 9 2 4 5 5 7 10 2 4 5 5 8 9 2 4 5 5 8 10 2 4 5 5 9 10 2 4 5 5 8 9 2 4 5 5 8 10 2 4 5 5 9 10 2 4 5 5 9 10 2 4 6 6 8 9 2 4 6 6 8 10 2 4 6 6 9 10 2 4 6 6 9 10 2 4 7 7 9 10 2 5 6 6 8 9 2 5 6 6 8 10 2 5 6 6 9 10 2 5 6 6 9 10 2 5 7 7 9 10 2 6 7 7 9 10 3 4 5 5 7 8 3 4 5 5 7 9 3 4 5 5 7 10 3 4 5 5 8 9 3 4 5 5 8 10 3 4 5 5 9 10 3 4 5 5 8 9 3 4 5 5 8 10 3 4 5 5 9 10 3 4 5 5 9 10 3 4 6 6 8 9 3 4 6 6 8 10 3 4 6 6 9 10 3 4 6 6 9 10 3 4 7 7 9 10 3 5 6 6 8 9 3 5 6 6 8 10 3 5 6 6 9 10 3 5 6 6 9 10 3 5 7 7 9 10 3 6 7 7 9 10 4 5 6 6 8 9 4 5 6 6 8 10 4 5 6 6 9 10 4 5 6 6 9 10 4 5 7 7 9 10 4 6 7 7 9 10 5 6 7 7 9 10
Т.е. ни одна из строчек не удовлетворяет условиям задачи.
Я же тебе показал как сделать. Напиши по аналогии только на VBA
Victoria nulla est, Quam quae confessos animo quoque subjugat hostes ...
Верю в смерть после жизни, любовь после секса и в крем после бритья ...
Верю в смерть после жизни, любовь после секса и в крем после бритья ...
#13
Отправлено 05 июля 2008 - 20:42
блин... опять не то послал... запарился просто... всесто второй c идет d
Sub proga1() r = 1 i = 1 u = 1 v = 1 Z = 1 j = 1 For a = 1 To 5 For b = a + 1 To a + 5 If b > 10 Then Exit For For c = b + 1 To b + 5 If c > 10 Then Exit For For d = c + 1 To c + 5 If d > 10 Then Exit For For e = d + 1 To d + 5 If e > 10 Then Exit For For f = e + 1 To e + 5 If f > 10 Then Exit For Cells(r, 1) = a r = r + 1 Cells(i, 2) = b i = i + 1 Cells(u, 3) = c u = u + 1 Cells(v, 4) = d v = v + 1 Cells(Z, 5) = e Z = Z + 1 Cells(j, 6) = f j = j + 1 Next Next Next Next Next Next End Sub
Смерть стоит того, чтобы жить,
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)
#15
Отправлено 05 июля 2008 - 20:55
1 2 3 4 5 6 1 2 3 4 5 7 1 2 3 4 5 8 1 2 3 4 5 9 1 2 3 4 5 10 1 2 3 4 6 7 1 2 3 4 6 8 1 2 3 4 6 9 1 2 3 4 6 10 1 2 3 4 7 8 1 2 3 4 7 9 1 2 3 4 7 10 1 2 3 4 8 9 1 2 3 4 8 10 1 2 3 4 9 10 1 2 3 5 6 7 1 2 3 5 6 8 1 2 3 5 6 9 1 2 3 5 6 10 1 2 3 5 7 8 1 2 3 5 7 9 1 2 3 5 7 10 1 2 3 5 8 9 1 2 3 5 8 10 1 2 3 5 9 10 1 2 3 6 7 8 1 2 3 6 7 9 1 2 3 6 7 10 1 2 3 6 8 9 1 2 3 6 8 10 1 2 3 6 9 10 1 2 3 7 8 9 1 2 3 7 8 10 1 2 3 7 9 10 1 2 3 8 9 10 1 2 4 5 6 7 1 2 4 5 6 8 1 2 4 5 6 9 1 2 4 5 6 10 1 2 4 5 7 8 1 2 4 5 7 9 1 2 4 5 7 10 1 2 4 5 8 9 1 2 4 5 8 10 1 2 4 5 9 10 1 2 4 6 7 8 1 2 4 6 7 9 1 2 4 6 7 10 1 2 4 6 8 9 1 2 4 6 8 10 1 2 4 6 9 10 1 2 4 7 8 9 1 2 4 7 8 10 1 2 4 7 9 10 1 2 4 8 9 10 1 2 5 6 7 8 1 2 5 6 7 9 1 2 5 6 7 10 1 2 5 6 8 9 1 2 5 6 8 10 1 2 5 6 9 10 1 2 5 7 8 9 1 2 5 7 8 10 1 2 5 7 9 10 1 2 5 8 9 10 1 2 6 7 8 9 1 2 6 7 8 10 1 2 6 7 9 10 1 2 6 8 9 10 1 2 7 8 9 10 1 3 4 5 6 7 1 3 4 5 6 8 1 3 4 5 6 9 1 3 4 5 6 10 1 3 4 5 7 8 1 3 4 5 7 9 1 3 4 5 7 10 1 3 4 5 8 9 1 3 4 5 8 10 1 3 4 5 9 10 1 3 4 6 7 8 1 3 4 6 7 9 1 3 4 6 7 10 1 3 4 6 8 9 1 3 4 6 8 10 1 3 4 6 9 10 1 3 4 7 8 9 1 3 4 7 8 10 1 3 4 7 9 10 1 3 4 8 9 10 1 3 5 6 7 8 1 3 5 6 7 9 1 3 5 6 7 10 1 3 5 6 8 9 1 3 5 6 8 10 1 3 5 6 9 10 1 3 5 7 8 9 1 3 5 7 8 10 1 3 5 7 9 10 1 3 5 8 9 10 1 3 6 7 8 9 1 3 6 7 8 10 1 3 6 7 9 10 1 3 6 8 9 10 1 3 7 8 9 10 1 4 5 6 7 8 1 4 5 6 7 9 1 4 5 6 7 10 1 4 5 6 8 9 1 4 5 6 8 10 1 4 5 6 9 10 1 4 5 7 8 9 1 4 5 7 8 10 1 4 5 7 9 10 1 4 5 8 9 10 1 4 6 7 8 9 1 4 6 7 8 10 1 4 6 7 9 10 1 4 6 8 9 10 1 4 7 8 9 10 1 5 6 7 8 9 1 5 6 7 8 10 1 5 6 7 9 10 1 5 6 8 9 10 1 5 7 8 9 10 1 6 7 8 9 10 2 3 4 5 6 7 2 3 4 5 6 8 2 3 4 5 6 9 2 3 4 5 6 10 2 3 4 5 7 8 2 3 4 5 7 9 2 3 4 5 7 10 2 3 4 5 8 9 2 3 4 5 8 10 2 3 4 5 9 10 2 3 4 6 7 8 2 3 4 6 7 9 2 3 4 6 7 10 2 3 4 6 8 9 2 3 4 6 8 10 2 3 4 6 9 10 2 3 4 7 8 9 2 3 4 7 8 10 2 3 4 7 9 10 2 3 4 8 9 10 2 3 5 6 7 8 2 3 5 6 7 9 2 3 5 6 7 10 2 3 5 6 8 9 2 3 5 6 8 10 2 3 5 6 9 10 2 3 5 7 8 9 2 3 5 7 8 10 2 3 5 7 9 10 2 3 5 8 9 10 2 3 6 7 8 9 2 3 6 7 8 10 2 3 6 7 9 10 2 3 6 8 9 10 2 3 7 8 9 10 2 4 5 6 7 8 2 4 5 6 7 9 2 4 5 6 7 10 2 4 5 6 8 9 2 4 5 6 8 10 2 4 5 6 9 10 2 4 5 7 8 9 2 4 5 7 8 10 2 4 5 7 9 10 2 4 5 8 9 10 2 4 6 7 8 9 2 4 6 7 8 10 2 4 6 7 9 10 2 4 6 8 9 10 2 4 7 8 9 10 2 5 6 7 8 9 2 5 6 7 8 10 2 5 6 7 9 10 2 5 6 8 9 10 2 5 7 8 9 10 2 6 7 8 9 10 3 4 5 6 7 8 3 4 5 6 7 9 3 4 5 6 7 10 3 4 5 6 8 9 3 4 5 6 8 10 3 4 5 6 9 10 3 4 5 7 8 9 3 4 5 7 8 10 3 4 5 7 9 10 3 4 5 8 9 10 3 4 6 7 8 9 3 4 6 7 8 10 3 4 6 7 9 10 3 4 6 8 9 10 3 4 7 8 9 10 3 5 6 7 8 9 3 5 6 7 8 10 3 5 6 7 9 10 3 5 6 8 9 10 3 5 7 8 9 10 3 6 7 8 9 10 4 5 6 7 8 9 4 5 6 7 8 10 4 5 6 7 9 10 4 5 6 8 9 10 4 5 7 8 9 10 4 6 7 8 9 10 5 6 7 8 9 10
Смерть стоит того, чтобы жить,
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)
А любовь стоит того, чтобы ждать
(Кино, Виктор Цой)