Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Настраиваемая распределение строк по столбцам - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Настраиваемая распределение строк по столбцам (Формулы/Formulas)
Настраиваемая распределение строк по столбцам
kaiyrkz0 Дата: Вторник, 26.09.2023, 09:07 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

2007
Добрый день! Столбцы с 5 000 строками. Надо что бы я мог задавать настройку по разбивке число строк и они разбивались. Пример разбивки по 20 строк указан справа. Надо что бы я могу указывать число строк по своему усмотрению.
К сообщению приложен файл: list_microsoft_excel_2.xlsx (11.8 Kb)
 
Ответить
СообщениеДобрый день! Столбцы с 5 000 строками. Надо что бы я мог задавать настройку по разбивке число строк и они разбивались. Пример разбивки по 20 строк указан справа. Надо что бы я могу указывать число строк по своему усмотрению.

Автор - kaiyrkz0
Дата добавления - 26.09.2023 в 09:07
Oh_Nick Дата: Вторник, 26.09.2023, 09:37 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 426
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
kaiyrkz0, так?
К сообщению приложен файл: list_microsoft_excel_2.xlsm (21.6 Kb)
 
Ответить
Сообщениеkaiyrkz0, так?

Автор - Oh_Nick
Дата добавления - 26.09.2023 в 09:37
Nic70y Дата: Вторник, 26.09.2023, 09:58 | Сообщение № 3
Группа: Друзья
Ранг: Экселист
Сообщений: 8511
Репутация: 2149 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub u_759()
    Application.ScreenUpdating = False
    x = Cells(1, Columns.Count).End(xlUp).Column
    y = Cells(Rows.Count, "g").End(xlUp).Row
    If x > 2 Then Range(Cells(1, 7), Cells(y, x)).Clear
    u = InputBox("Ââåñòè Êîë-âî ñòðîê")
    a = Cells(Rows.Count, "a").End(xlUp).Row
    If IsNumeric(u) Then
        b = Application.Round(a / u + 0.5, 0)
        For c = 1 To b
            Range("a" & (c - 1) * u + 1 & ":b" & c * u).Copy Cells(1, c * 2 + 5)
        Next
    End If
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 99.xlsm (20.1 Kb)


ЮMoney 41001841029809
 
Ответить
Сообщение[vba]
Код
Sub u_759()
    Application.ScreenUpdating = False
    x = Cells(1, Columns.Count).End(xlUp).Column
    y = Cells(Rows.Count, "g").End(xlUp).Row
    If x > 2 Then Range(Cells(1, 7), Cells(y, x)).Clear
    u = InputBox("Ââåñòè Êîë-âî ñòðîê")
    a = Cells(Rows.Count, "a").End(xlUp).Row
    If IsNumeric(u) Then
        b = Application.Round(a / u + 0.5, 0)
        For c = 1 To b
            Range("a" & (c - 1) * u + 1 & ":b" & c * u).Copy Cells(1, c * 2 + 5)
        Next
    End If
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 26.09.2023 в 09:58
kaiyrkz0 Дата: Вторник, 26.09.2023, 10:08 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

2007
Oh_Nick, Да почти. Но Что бы и остаток рядом по числу заданных строк вставлял.
 
Ответить
СообщениеOh_Nick, Да почти. Но Что бы и остаток рядом по числу заданных строк вставлял.

Автор - kaiyrkz0
Дата добавления - 26.09.2023 в 10:08
msi2102 Дата: Вторник, 26.09.2023, 11:09 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 399
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007
Ещё Вариант, результат на Лист2
[vba]
Код
Sub Разделить()
    Dim arr1, arr2, n As Long, m As Long, i As Long
    m = InputBox("Ввести кол-во строк")
    n = Cells(Rows.Count, "A").End(xlUp).Row
    arr1 = Range(Cells(1, 1), Cells(n, 2))
    i = IIf(n Mod m > 0, Fix(n / m) * 2 + 2, Fix(n / m) * 2)
    ReDim arr2(1 To m, 1 To i)
    n = 1: m = 1
    For i = 1 To UBound(arr1)
        arr2(n, m) = arr1(i, 1)
        arr2(n, m + 1) = arr1(i, 2)
        If n = UBound(arr2) Then n = 1: m = m + 2 Else n = n + 1
    Next
    With Worksheets("Лист2")
        .Cells.Clear
        .Range("A1").Resize(UBound(arr2), UBound(arr2, 2)) = arr2
        .Activate
    End With
End Sub
[/vba]
К сообщению приложен файл: 5555.xlsm (20.9 Kb)


Сообщение отредактировал msi2102 - Вторник, 26.09.2023, 11:10
 
Ответить
СообщениеЕщё Вариант, результат на Лист2
[vba]
Код
Sub Разделить()
    Dim arr1, arr2, n As Long, m As Long, i As Long
    m = InputBox("Ввести кол-во строк")
    n = Cells(Rows.Count, "A").End(xlUp).Row
    arr1 = Range(Cells(1, 1), Cells(n, 2))
    i = IIf(n Mod m > 0, Fix(n / m) * 2 + 2, Fix(n / m) * 2)
    ReDim arr2(1 To m, 1 To i)
    n = 1: m = 1
    For i = 1 To UBound(arr1)
        arr2(n, m) = arr1(i, 1)
        arr2(n, m + 1) = arr1(i, 2)
        If n = UBound(arr2) Then n = 1: m = m + 2 Else n = n + 1
    Next
    With Worksheets("Лист2")
        .Cells.Clear
        .Range("A1").Resize(UBound(arr2), UBound(arr2, 2)) = arr2
        .Activate
    End With
End Sub
[/vba]

Автор - msi2102
Дата добавления - 26.09.2023 в 11:09
kaiyrkz0 Дата: Вторник, 26.09.2023, 12:19 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

2007
Oh_Nick, Nic70y, msi2102, Всем спасибо.
 
Ответить
СообщениеOh_Nick, Nic70y, msi2102, Всем спасибо.

Автор - kaiyrkz0
Дата добавления - 26.09.2023 в 12:19
kaiyrkz0 Дата: Среда, 27.09.2023, 12:43 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

2007
Nic70y, msi2102, Как сделать что бы распределял три столбца: номер, имя, число.?
 
Ответить
СообщениеNic70y, msi2102, Как сделать что бы распределял три столбца: номер, имя, число.?

Автор - kaiyrkz0
Дата добавления - 27.09.2023 в 12:43
Nic70y Дата: Среда, 27.09.2023, 12:50 | Сообщение № 8
Группа: Друзья
Ранг: Экселист
Сообщений: 8511
Репутация: 2149 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub u_759()
    Application.ScreenUpdating = False
    x = Cells(1, Columns.Count).End(xlUp).Column
    y = Cells(Rows.Count, "g").End(xlUp).Row
    If x > 2 Then Range(Cells(1, 7), Cells(y, x)).Clear
    u = InputBox("Ввести Кол-во строк")
    a = Cells(Rows.Count, "a").End(xlUp).Row
    If IsNumeric(u) Then
        b = Application.Round(a / u + 0.5, 0)
        For c = 1 To b
            Range("a" & (c - 1) * u + 1 & ":c" & c * u).Copy Cells(1, c * 3 + 4)
        Next
    End If
    Application.ScreenUpdating = True
End Sub
[/vba]
Range("a" & (c - 1) * u + 1 & ":c" & c * u).Copy Cells(1, c * 3 + 4)


ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Среда, 27.09.2023, 12:50
 
Ответить
Сообщение[vba]
Код
Sub u_759()
    Application.ScreenUpdating = False
    x = Cells(1, Columns.Count).End(xlUp).Column
    y = Cells(Rows.Count, "g").End(xlUp).Row
    If x > 2 Then Range(Cells(1, 7), Cells(y, x)).Clear
    u = InputBox("Ввести Кол-во строк")
    a = Cells(Rows.Count, "a").End(xlUp).Row
    If IsNumeric(u) Then
        b = Application.Round(a / u + 0.5, 0)
        For c = 1 To b
            Range("a" & (c - 1) * u + 1 & ":c" & c * u).Copy Cells(1, c * 3 + 4)
        Next
    End If
    Application.ScreenUpdating = True
End Sub
[/vba]
Range("a" & (c - 1) * u + 1 & ":c" & c * u).Copy Cells(1, c * 3 + 4)

Автор - Nic70y
Дата добавления - 27.09.2023 в 12:50
kaiyrkz0 Дата: Пятница, 27.10.2023, 12:48 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

2007
Nic70y, Как сделать что бы распределял четыре столбца: номер, имя, число, пустая ячейка? или что бы запрашивал сколько столбцов брать как в случае со строками. Большое спасибо.


Сообщение отредактировал kaiyrkz0 - Пятница, 27.10.2023, 13:21
 
Ответить
СообщениеNic70y, Как сделать что бы распределял четыре столбца: номер, имя, число, пустая ячейка? или что бы запрашивал сколько столбцов брать как в случае со строками. Большое спасибо.

Автор - kaiyrkz0
Дата добавления - 27.10.2023 в 12:48
Nic70y Дата: Пятница, 27.10.2023, 13:27 | Сообщение № 10
Группа: Друзья
Ранг: Экселист
Сообщений: 8511
Репутация: 2149 ±
Замечаний: 0% ±

Excel 2010
kaiyrkz0, думал догадаетесь[vba]
Код
Range("a" & (c - 1) * u + 1 & ":d" & c * u).Copy Cells(1, c * 4 + 3)
[/vba]


ЮMoney 41001841029809
 
Ответить
Сообщениеkaiyrkz0, думал догадаетесь[vba]
Код
Range("a" & (c - 1) * u + 1 & ":d" & c * u).Copy Cells(1, c * 4 + 3)
[/vba]

Автор - Nic70y
Дата добавления - 27.10.2023 в 13:27
msi2102 Дата: Пятница, 27.10.2023, 13:31 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 399
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007
Уже не помню, что я там писал, но попробуйте так, вставляйте сколько нужно столбцов
[vba]
Код
Sub Разделить()
    Dim arr1, arr2, n As Long, m As Long, i As Long
    k = InputBox("Ввести кол-во столбцов в таблице")
    m = InputBox("Ввести кол-во строк")
    n = Cells(Rows.Count, "A").End(xlUp).Row
    arr1 = Range(Cells(1, 1), Cells(n, CInt(k)))
    i = IIf(n Mod m > 0, Fix(n / m) * k + k, Fix(n / m) * k)
    ReDim arr2(1 To m, 1 To i)
    n = 1: m = 1
    For i = 1 To UBound(arr1)
        For v = 1 To k
            arr2(n, m + v - 1) = arr1(i, v)
        Next
        If n = UBound(arr2) Then n = 1: m = m + k Else n = n + 1
    Next
    With Worksheets("Лист2")
        .Cells.Clear
        .Range("A1").Resize(UBound(arr2), UBound(arr2, 2)) = arr2
        .Activate
    End With
End Sub
[/vba]
PS подправил код
К сообщению приложен файл: 5555_1.xlsm (22.8 Kb)


Сообщение отредактировал msi2102 - Пятница, 27.10.2023, 13:38
 
Ответить
СообщениеУже не помню, что я там писал, но попробуйте так, вставляйте сколько нужно столбцов
[vba]
Код
Sub Разделить()
    Dim arr1, arr2, n As Long, m As Long, i As Long
    k = InputBox("Ввести кол-во столбцов в таблице")
    m = InputBox("Ввести кол-во строк")
    n = Cells(Rows.Count, "A").End(xlUp).Row
    arr1 = Range(Cells(1, 1), Cells(n, CInt(k)))
    i = IIf(n Mod m > 0, Fix(n / m) * k + k, Fix(n / m) * k)
    ReDim arr2(1 To m, 1 To i)
    n = 1: m = 1
    For i = 1 To UBound(arr1)
        For v = 1 To k
            arr2(n, m + v - 1) = arr1(i, v)
        Next
        If n = UBound(arr2) Then n = 1: m = m + k Else n = n + 1
    Next
    With Worksheets("Лист2")
        .Cells.Clear
        .Range("A1").Resize(UBound(arr2), UBound(arr2, 2)) = arr2
        .Activate
    End With
End Sub
[/vba]
PS подправил код

Автор - msi2102
Дата добавления - 27.10.2023 в 13:31
kaiyrkz0 Дата: Понедельник, 30.10.2023, 09:40 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

2007
Nic70y, msi2102, Большое спасибо.
 
Ответить
СообщениеNic70y, msi2102, Большое спасибо.

Автор - kaiyrkz0
Дата добавления - 30.10.2023 в 09:40
jakim Дата: Вторник, 31.10.2023, 16:22 | Сообщение № 13
Группа: Друзья
Ранг: Старожил
Сообщений: 1188
Репутация: 312 ±
Замечаний: 0% ±

Excel 2010
Формула

Код
=IF(ROWS($2:2)<=$D$1;INDEX($A:$B;MOD(ROWS($1:2)-1;$D$1+1)+TRUNC((CEILING(COLUMNS($H:H)/2;1)-1)*$D$1)+1;MOD(COLUMNS($F:F)-1;2)+1);"")
К сообщению приложен файл: 6184702.xlsx (13.6 Kb)


Сообщение отредактировал jakim - Вторник, 31.10.2023, 16:24
 
Ответить
Сообщение
Формула

Код
=IF(ROWS($2:2)<=$D$1;INDEX($A:$B;MOD(ROWS($1:2)-1;$D$1+1)+TRUNC((CEILING(COLUMNS($H:H)/2;1)-1)*$D$1)+1;MOD(COLUMNS($F:F)-1;2)+1);"")

Автор - jakim
Дата добавления - 31.10.2023 в 16:22
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Настраиваемая распределение строк по столбцам (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2023 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!