Профессиональные приемы работы в Microsoft Excel

Пожалуйста, войдите или зарегистрируйтесь.


Расширенный поиск  

Новости:

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

Автор Тема: Разбить столбцы с заданным диапазоном  (Прочитано 110 раз)

0 Пользователей и 1 Гость просматривают эту тему.

O39I

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 2

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

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

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

Благодарен заранее за оказанную помощь.
« Последнее редактирование: 15.05.2018, 14:48:58 от O39I »
Записан

boa

  • Глобальный модератор
  • Постоялец
  • *****
  • Уважение: +26/-0
  • Оффлайн Оффлайн
  • Сообщений: 466
  • Доброта спасет мир...

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

или формулами, как в предыдущей теме
« Последнее редактирование: 15.05.2018, 15:59:49 от vikttur »
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

O39I

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 2

...
или формулами, как в предыдущей теме

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

Записан
 



Темы без ответов

22.05.2018 11:38 Скрипт написать который допишет данные в файл 47
03.03.2018 00:00 Подсчет отработанного времени, за исключением заранее определенных перерывов 503
14.02.2018 10:11 Подготовить читабельную отчетность по платежам 499
23.01.2018 13:46 Найти вероятность повторной покупки 515
12.01.2018 23:56 Сделать отчет на Power BI (Dashboard) 685
06.09.2017 10:43 Solver VBA не решает гиперболическое уравнение, но при этом решает гармоническое 806
17.08.2017 12:15 Гиперссылка и фильтр одновременно макрос 1007
23.05.2017 11:20 Копирование данных из одной таблицы в умную таблицу по условию 2415
15.03.2017 15:45 автозамена картинок PowerPoint 1509
11.03.2017 13:43 Изменить нумерацию страниц 1737





Яндекс цитирования msexcel.ru Яндекс.Метрика

Страница сгенерирована за 0.181 секунд. Запросов: 101.