Страницы: 1
RSS
Макрос. Копирование и вставка транспонированием по условию.
 
Приветствую!
Есть ли возможность сделать макрос. который будет копировать содержимое столбцов А6:J6. И вставлять-транспонированием в другое место  по условию первого столбца.
Отправляю файл для понимания.
 
добрый!
почему нельзя все данные сразу транспонировать?
Код
let
    a = Table.Group(Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], {"C"}, {"q", Table.Transpose}),
    b = Table.Combine(a[q])
in
    b
 
Дмитрий,
Код
Sub mrshkei()
Dim arr, arr2, i As Long, n As Long, lr As Long, col As New Collection
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A6:J" & lr)
For i = LBound(arr) To UBound(arr)
    On Error Resume Next
    col.Add arr(i, 1), CStr(arr(i, 1))
Next i
l = 6
For i = 1 To col.Count
x = Application.WorksheetFunction.CountIf(Columns(1), col(i))
ReDim arr2(1 To 10, 1 To x)
k = 1
    For n = LBound(arr) To UBound(arr)
        If col(i) = arr(n, 1) Then
            arr2(1, k) = arr(n, 1)
            arr2(2, k) = arr(n, 2)
            arr2(3, k) = arr(n, 3)
            arr2(4, k) = arr(n, 4)
            arr2(5, k) = arr(n, 5)
            arr2(6, k) = arr(n, 6)
            arr2(7, k) = arr(n, 7)
            arr2(8, k) = arr(n, 8)
            arr2(9, k) = arr(n, 9)
            arr2(10, k) = arr(n, 10)
            k = k + 1
        End If
    Next n
    Range("S" & l).Resize(UBound(arr2), x) = arr2
    l = l + 10 + 3
Next i
MsgBox col.Count
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, Очень благодарен вам!
 
Дмитрий,
А с длиной кабеля разобрались?
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=137675
 
Kuzmich, да, ещё раз благодарю
Страницы: 1
Наверх