Подскажите, пожалуйста, реально ли перенести данные ячеек из столбика в строчку в такой ситуации? В таблице (во вложении) список работников и даты, нужно перенести даты из столбика в строку напротив ФИО работника.
Kubix, ориентировался на группировку 3-4 если ее нет результата не бдует.
Код
Sub Макрос1()
Dim i As Long, lr As Long, x As Long, x2 As Long, n As Long, k As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
x = Rows(i).OutlineLevel
If x = 3 Then
k = 2
For n = i + 1 To lr
x2 = Rows(n).OutlineLevel
If x2 = 4 Then
Cells(i, k) = Cells(n, 1)
k = k + 1
Else
i = n - 1
Exit For
End If
Next n
End If
Next i
End Sub
Mershik,Да не, это я криво вырезал часть таблицы, все хорошо переносит в основной. Я думал, что как-то облегчит мне задачу, но нет. Подскажите, пожалуйста, а можно ли с несколькими столбцами такое же проделать? Напротив этих дат есть цифры, во вложении пример как это должно переносится.
vokilook, уже пишу третий раз.. Почему-то отправляет на одобрение модераторам.. Я понял косяк свой, нужно вставить в ручную пустые строчки для вывода информации третьего столбца.
Sub Макрос1()
Dim i As Long, lr As Long, x As Long, x2 As Long, n As Long, k As Long
Dim flag As Boolean
flag = True
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
lvl = Rows(i).OutlineLevel
If lvl = 3 Then
colmn = 4
For n = i + 1 To lr
lvl2 = Rows(n).OutlineLevel
If flag And Rows(n + 1).OutlineLevel <> 4 Then
Rows(n + 1).Insert Shift:=xlDown
flag = False
Else
flag = False
End If
If lvl2 = 4 Then
Cells(i, colmn) = Cells(n, 1)
Cells(i + 1, colmn) = Cells(n, 2)
Cells(i + 2, colmn) = Cells(n, 3)
colmn = colmn + 1
Else
i = n - 1
Exit For
End If
Next n
End If
flag = True
Next i
End Sub