Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Главное меню

Разбить столбцы с заданным диапазоном

Автор O39I, 15.05.2018, 14:40

« назад - далее »

O39I

Доброго времени суток!

Помогите дописать скрипт для разбивки столбцов.
Суть - есть два столбца с определёнными числами.Их много обычно и всегда разные, но всегда только два столбца. Их необходимо разбить на заданное количество с определённым интервалом(обычно 100 или 50).Файл прикрепляю. На листе "Как должно" показан желаемый результат.

Пример.Вводим первое значение 100 а второе 2.В итоге получаем,что данные разбиваются по 100 и на два столбца - в первом столбце идут числа от 1 до 100 во от втором 101 до 200. Следующая сотня от 201 до 300 ложится в первый столбец, а вторая сотня от 301 до 400 ложится во второй и т.д.

Благодарен заранее за оказанную помощь.

boa

#1
Private Sub Knopka_Click()

    Dim a As Long, inArr(), j As Long, k As Long, L As Long
    On Error Resume Next
    a = Okno.TB1.Value
    b = Okno.TB2.Value
    If Err.Number <> 0 Or a < 1 Then Unload Me: Exit Sub
   
    inArr = Worksheets("Auei").Range([A2], [B2].End(xlDown)).Value
        With Worksheets("Noaei").Range("A1")
        .Cells.Clear
        j = 1
        For L = 1 To UBound(inArr, 1)
           k = k + 1
            .Cells(k, j * 2 - 1) = inArr(L, 1)
            .Cells(k, j * 2) = inArr(L, 2)
            If L / a = j Then j = j + 1: k = 0
        Next L
        .Activate
End With

или формулами, как в предыдущей теме
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

O39I

Цитата: boa от 15.05.2018, 15:37
...
или формулами, как в предыдущей теме

Супер!Оказывается так просто, а я голову ломал. Огромное спасибо за оперативный ответ.Всё работает.