Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоматический перенос строк в столбцы
 
#1
16.12.2020 14:56:09
Требуется перенести три строки таблицы в три столбца, в самой таблице строк может быть много. А выходные столбцы должны идти один за одним. Понимаю что тут вроде все просто, но как это автоматизировать не знаю.
В итоге должно получаться как в приложенной таблице.
 
 
 
#2
16.12.2020 15:10:08
Александр Морозов,
Код
Sub mrshkei()
Dim r As Long, c As Long, arr, lr As Long, lc As Long, rng As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim arr(1 To lr * lc)
j = 1
For r = 1 To lr
    For c = 1 To lc
    arr(j) = Cells(r, c)
    j = j + 1
    Next c
Next r
Range("A6").Resize(UBound(arr), 1) = WorksheetFunction.Transpose(arr)
End Sub
Изменено: Mershik - 16.12.2020 15:12:52
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
16.12.2020 15:37:51
Код
Sub iConvert()
Dim i As Long
Dim j As Long
Dim n As Long
Dim iLastRow As Long
Dim iLastCol As Integer
Dim arr
Dim arr1
  iLastRow = Range("A1").End(xlDown).Row
  iLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  arr = Range(Cells(1, 1), Cells(iLastRow, iLastCol)).Value
  ReDim arr1(1 To UBound(arr) * UBound(arr, 2), 1 To 1)
    n = 0
  For i = 1 To UBound(arr)
    For j = 1 To UBound(arr, 2)
      arr1(j + UBound(arr, 2) * n, 1) = arr(i, j)
    Next
      n = n + 1
  Next
    Range("A6").Resize(UBound(arr) * UBound(arr, 2)) = arr1
End Sub
Изменено: Kuzmich - 16.12.2020 15:56:11
 
 
 
#4
16.12.2020 16:08:32
Спасибо вам люди добрые!!! :)  
 
 
 
#5
16.12.2020 16:43:49
Формулой
Код
=IFERROR(INDEX($A$1:$C$10;AGGREGATE(15;6;ROW($1:$20)/(A$1:C$10<>"");ROWS($1:1));MOD(ROWS($1:1)-1;COUNTA($A$1:$C$1))+1);"")
Изменено: jakim - 16.12.2020 16:44:16
 
 
 
Страницы: 1
Наверх