макрос VBA EXCEL - деление ряда чисел по заданному критерию

[Обыватель]

Добрый день! Подскажите, пожалуйста, как решить задачу: имеем ранжированный ряд значений. Задача - разбить ряд на группы таким образом, чтобы крайние значения групп отличались не более, чем в два раза.
Как будет выглядеть код?

[SAS888]

А если дан ряд, например: 1, 10, 100, 1000, ... Тогда что?
Условие для ряда произвольных значений задано некорректно.

[Обыватель]

Сообщение от SAS888

А если дан ряд, например: 1, 10, 100, 1000, ... Тогда что?
Условие для ряда произвольных значений задано некорректно.

точно!
тогда уточняю: необходимо условие для ряда типа - 4, 6, 8, 10, 11, 14, 16, 20, 22, 24, 27 ...

[SAS888]

Пусть столбец "A" содержит ряд ранжированных чисел.
Следующий макрос "разобьет" этот ряд по столбцам, согласно заданному условию.

Sub Ranking()
    Dim i As Long, j As Long, a As Long
    j = 2
    a = Cells(1, 1)
    For i = 1 To Range("A65536").End(xlUp).Row
        If a * 2 >= Cells(i, 1) Then
            Cells(Cells(65536, j).End(xlUp).Row + 1, j) = Cells(i, 1)
        Else
            j = j + 1
            Cells(Cells(65536, j).End(xlUp).Row + 1, j) = Cells(i, 1)
            a = Cells(i, 1)
        End If
    Next i
End Sub

[Обыватель]

Большое спасибо! Теперь логика понятна.

[slan]

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 не вызовет ошибку несоответствия типа.

кстати, "исходный код" пропускает первую "порцию" данных, а остальное записывает начиная со второй строчки(а не с первой)

[slan]

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 не вызовет ошибку несоответствия типа.

кстати, "исходный код" пропускает первую "порцию" данных, а остальное записывает начиная со второй строчки(а не с первой)

[Обыватель]

Slan
Понял, спасибо !

[SAS888]

На счет строк соглашусь с Вами, а все остальное полностью удовлетворяло условию задачи.
Во-первых:

имеем ранжированный ряд значений. Задача - разбить ряд на группы таким образом, чтобы крайние значения групп отличались не более, чем в два раза

Т. е. все значения - числа, иначе как Вы понимаете, что строковые переменные отличаются в два раза?
Во-вторых:

Задача - разбить ряд на группы

Что такое "группы", где их располагать, или куда девать? (кто требует располагать именно в этих столбцах и именно с первой строки?) Я вообще сначала хотел предложить создать массивы с этими "группами". Раз условием это не задано, то минимизирован код.

Поясните, что значит

"исходный код" пропускает первую "порцию" данных

???

[slan]

кстати, насчет превой порции - это у меня заморочка при тестировании - беру слова обратно.
а насчет минимизации.. если привести к аналогичному виду
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

выглядит короче ), хотя исполнение кода полностью аналогично