Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как перенести отдельные блоки одного столбца в разные столбцы?
 
#1
25.08.2019 06:12:32
Всем привет.
Задача вроде простая, но никак не додумаюсь самостоятельно, помогите пожалуйста.

Нужно данные с листа1, которые расположены в столбик блоками перенести на лист2, разбив эти блоки на отдельные столбцы, последовательно.  Разбивка будет на равные блоки, например по 50 ячеек в каждом блоке, 50 блоков.

В примере (прикрепленный файл) на листе1  столбец А  состоит из 5 равных блоков по 6 ячеек в каждом. Этот столбец перенесли на лист2 в виде 5 столбцов (по 6 ячеек в каждом столбце).  Цветами залиты столбцы для лучшего восприятия, заливка не нужна.
 
 
 
#2
25.08.2019 06:13:36
Скриншот
 
 
 
#3
25.08.2019 06:22:26
Код
Sub exploudrange()
Dim i, s, x, c, b, d, j, shag As Double
Dim diap As Range
On Error GoTo nba
Set diap = Application.InputBox("Выберите столбец", "Выбор диапазона", , , , , , 8)
On Error GoTo nba
shag = InputBox("Введите Шаг дл разделения", "Шаг разделения", 6)
On Error GoTo nba
x = Application.CountA(diap)
d = diap.End(xlDown).Column
 For s = 1 To x
 If Cells(s, d) = "" Then
    Rows(s + c).Delete
 End If
 Next s
c = diap.End(xlDown).Row 
b = Application.CountA(diap) 
d = diap.End(xlDown).Column 
 If c = b Then
    c = 1
 Else
    c = diap.End(xlDown).Row
 End If
 
For i = 1 To b Step shag
    For j = 1 To shag
    Cells((i - ((shag - 1) * (Int(i / shag))) + (c - 1)), j + 1 + (d - 1)).Value = _
                    Cells((i + (j - 1) + (c - 1)), d).Value
    Next j
Next i
MsgBox "Готово"
nba:
End Sub
Изменено: nbaengineer - 25.08.2019 07:03:58
Вредить легко, помогать трудно.
 
 
 
#4
25.08.2019 09:03:13
Код
Sub Отевт_на_Вопорс() 'в код листа 1
With Sheets(2)
i = 0
For Each rr In Columns(1).SpecialCells(2).Areas
rr.Copy Destination:=Sheets(2).Cells(2, 3).Offset(, i): i = i + 1
Next
End With
Beep
End Sub
 
 
 
#5
25.08.2019 10:25:31
формулой и в Power Query
Код
=ЕСЛИ(СТРОКА(A1)<7;ИНДЕКС(Sheet1!$A$1:$A$50;ОСТАТ(СТРОКА(A1)-1;7)+1+(7*СТОЛБЕЦ(A1))-7);"")
Изменено: artyrH - 25.08.2019 10:45:58
 
 
 
#6
25.08.2019 10:48:38
до кучи PQ
Код
let
    from = Excel.Workbook(File.Contents(Excel.CurrentWorkbook(){[Name="file"]}[Content]{0}[file])){[Name="Sheet1"]}[Data],
    list = List.Split(from[Column1],7),
    table = Table.FromRows(list),
    to = Table.Transpose(table)
in
    to
Изменено: buchlotnik - 25.08.2019 10:48:49
Соблюдение правил форума не освобождает от модераторского произвола
 
 
 
#7
25.08.2019 13:38:57
Уважаемые форумчане, добрый день!
Подскажите, пжл, правильно ли я понимаю, что метод SpecialCells, который применил  k61, можно применить только к столбцу или строке?
Спасибо.  
 
 
 
#8
25.08.2019 13:42:13
Цитата
Smurov написал:
правильно ли я понимаю
нет.
 
 
 
#9
25.08.2019 13:54:48
k61, Не подскажите, где можно побольше почитать про SpecialCells, а то справка крайне скупая.
Заранее спасибо.
 
 
 
#10
25.08.2019 14:46:33
Цитата
tamilla8484 написал:
например по 50 ячеек в каждом блоке, 50 блоков
нажимаем Ctrl+G -ввели конечную ячейку->нажимаем Shift+Enter->выделяем строку формул, вводим формулу и нажимаем Ctrl+Shift+Enter
главное поставить нужные числа в СТРОКА()-9; СТРОКА()-10; СТОЛБЕЦ()-2
Код
=ЕСЛИОШИБКА(ЕСЛИ(СТРОКА()-9<7;ИНДЕКС(Sheet1!R1C1:R50000C1;ОСТАТ(СТРОКА()-10;7)+1+(7*(СТОЛБЕЦ()-2))-7);"");"")
Изменено: artyrH - 25.08.2019 14:54:29
 
 
 
#11
25.08.2019 19:46:24
Уважаемые форумчане, трудно понять откуда у вас у всех столько доброты и желание помочь абсолютно незнакомым людям.... Всегда восхищаюсь людьми способными на благотворительность. Вы вдохновляете окружающих быть еще добрее и помогать нуждающимся. Огромное спасиб всем. :)   Задача решена.
 
 
 
Страницы: 1
Наверх