|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу. Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста". Название темы слишком короткое или не отражает сути вашего вопроса. Тема исчерпала себя, помните, один вопрос - одна тема Прочитайте правила и заново правильно создайте тему. |
|
Опции темы | Поиск в этой теме |
25.01.2008, 09:39 | #1 |
Пользователь
Регистрация: 21.01.2008
Сообщений: 98
|
макрос VBA EXCEL - деление ряда чисел по заданному критерию
Добрый день! Подскажите, пожалуйста, как решить задачу: имеем ранжированный ряд значений. Задача - разбить ряд на группы таким образом, чтобы крайние значения групп отличались не более, чем в два раза.
Как будет выглядеть код? |
25.01.2008, 09:55 | #2 |
Старожил
Регистрация: 05.12.2007
Сообщений: 4,180
|
А если дан ряд, например: 1, 10, 100, 1000, ... Тогда что?
Условие для ряда произвольных значений задано некорректно.
Чем шире угол зрения, тем он тупее.
|
25.01.2008, 13:53 | #3 |
Пользователь
Регистрация: 21.01.2008
Сообщений: 98
|
|
26.01.2008, 16:44 | #4 |
Старожил
Регистрация: 05.12.2007
Сообщений: 4,180
|
Пусть столбец "A" содержит ряд ранжированных чисел.
Следующий макрос "разобьет" этот ряд по столбцам, согласно заданному условию. Код:
Чем шире угол зрения, тем он тупее.
|
30.01.2008, 09:18 | #5 |
Пользователь
Регистрация: 21.01.2008
Сообщений: 98
|
Большое спасибо! Теперь логика понятна.
|
30.01.2008, 12:23 | #6 |
Форумчанин
Регистрация: 30.01.2008
Сообщений: 314
|
позволю себе немножко поправить
Sub Ranking()
Dim i As Long, j As Long, a As Long, nrow As Long nrow = 1 j = 2 a = Cells(1, 1) For i = 1 To Cells(Columns(1).Rows.Count, 1).End(xlUp).Row If IsNumeric(Cells(i, 1)) Then If a * 2 < Cells(i, 1) Then j = j + 1 a = Cells(i, 1) nrow = 1 End If Cells(nrow, j) = Cells(i, 1) nrow = nrow + 1 End If Next End Sub самое главное в этом - что строк может быть больше 65536, на дворе 2008й ну и при наличии нецифровых значений код a=cells не вызовет ошибку несоответствия типа. кстати, "исходный код" пропускает первую "порцию" данных, а остальное записывает начиная со второй строчки(а не с первой) |
30.01.2008, 12:23 | #7 |
Форумчанин
Регистрация: 30.01.2008
Сообщений: 314
|
позволю себе немножко поправить
Sub Ranking()
Dim i As Long, j As Long, a As Long, nrow As Long nrow = 1 j = 2 a = Cells(1, 1) For i = 1 To Cells(Columns(1).Rows.Count, 1).End(xlUp).Row If IsNumeric(Cells(i, 1)) Then If a * 2 < Cells(i, 1) Then j = j + 1 a = Cells(i, 1) nrow = 1 End If Cells(nrow, j) = Cells(i, 1) nrow = nrow + 1 End If Next End Sub самое главное в этом - что строк может быть больше 65536, на дворе 2008й ну и при наличии нецифровых значений код a=cells не вызовет ошибку несоответствия типа. кстати, "исходный код" пропускает первую "порцию" данных, а остальное записывает начиная со второй строчки(а не с первой) |
30.01.2008, 13:07 | #8 |
Пользователь
Регистрация: 21.01.2008
Сообщений: 98
|
Slan
Понял, спасибо ! |
30.01.2008, 13:30 | #9 | |||
Старожил
Регистрация: 05.12.2007
Сообщений: 4,180
|
На счет строк соглашусь с Вами, а все остальное полностью удовлетворяло условию задачи.
Во-первых: Цитата:
Во-вторых: Цитата:
Поясните, что значит Цитата:
Чем шире угол зрения, тем он тупее.
Последний раз редактировалось SAS888; 30.01.2008 в 14:32. |
|||
30.01.2008, 14:17 | #10 |
Форумчанин
Регистрация: 30.01.2008
Сообщений: 314
|
я же и не ругаюсь..
кстати, насчет превой порции - это у меня заморочка при тестировании - беру слова обратно.
а насчет минимизации.. если привести к аналогичному виду Sub Ranking() Dim i As Long, j As Long, a As Long j = 2 a = Cells(1, 1) For i = 1 To Cells(Columns(1).Rows.Count, 1).End(xlUp).Row If a * 2 < Cells(i, 1) Then j = j + 1 a = Cells(i, 1) End If Cells(Columns(j).Rows.Count, j)).End(xlUp).offset(1) = Cells(i, 1) Next End Sub выглядит короче ), хотя исполнение кода полностью аналогично |
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
макрос перехода на заданный лист в excel | Руслан Набиуллин | Microsoft Office Excel | 2 | 06.08.2008 20:46 |
программа перестановки чисел натурального ряда от 1 до 10 | Ольга 01 | Общие вопросы C/C++ | 1 | 28.07.2008 20:09 |
помогите, пожалуйсто, написать макрос для excel | bacalavr | Microsoft Office Excel | 2 | 04.04.2008 11:39 |
макрос VBA Excel | Bor | Microsoft Office Excel | 5 | 25.01.2008 12:20 |
Деление чисел в двоичной системе счисления | Mss_Smith | Помощь студентам | 9 | 04.05.2007 17:02 |