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

Вход

Регистрация

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

 

= Мир MS Excel/Транспортировка строк в столбцы и наоборот - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Транспортировка строк в столбцы и наоборот (Макросы/Sub)
Транспортировка строк в столбцы и наоборот
DAN123 Дата: Среда, 04.09.2019, 22:55 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день!

Помогите пожалуйста с написанием макроса.
Необходимо решить это именно с макросом, так как необходимо обработать большой массив данных.

На первом листе отражено как нужно. На остальных - пример данных.
Нужно чтобы создавалась таблица по нажатию "Кнопки" создавалась новая книга.

Нужно чтобы данные собирались циклом из столбцов в строки и наоборот.
Чтобы данные столбца исходной таблицы (A1:A6) были в шапке таблицы строкой A1:F1 (в каждом листе). А сами данные на каждом листе (по годам) в столбце были в строке. Т.е. Данные столбца B2:B6 в B2:F2.

Написал пример кода. Но все не то.

Пожалуйста, помогите разобраться. Спасибо

Нигде не нашел подобного примера. Очень нужно.
К сообщению приложен файл: 1.xlsx.xlsm(21.6 Kb)
 
Ответить
СообщениеДобрый день!

Помогите пожалуйста с написанием макроса.
Необходимо решить это именно с макросом, так как необходимо обработать большой массив данных.

На первом листе отражено как нужно. На остальных - пример данных.
Нужно чтобы создавалась таблица по нажатию "Кнопки" создавалась новая книга.

Нужно чтобы данные собирались циклом из столбцов в строки и наоборот.
Чтобы данные столбца исходной таблицы (A1:A6) были в шапке таблицы строкой A1:F1 (в каждом листе). А сами данные на каждом листе (по годам) в столбце были в строке. Т.е. Данные столбца B2:B6 в B2:F2.

Написал пример кода. Но все не то.

Пожалуйста, помогите разобраться. Спасибо

Нигде не нашел подобного примера. Очень нужно.

Автор - DAN123
Дата добавления - 04.09.2019 в 22:55
K-SerJC Дата: Четверг, 05.09.2019, 10:09 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 456
Репутация: 74 ±
Замечаний: 0% ±

Excel 2013
Нужно чтобы данные собирались циклом

добрый день!
а если просто транспонировать ?
[vba]
Код
Windows("1.xlsx.xlsm").Activate
    Range("A1:W40").Copy
    Windows("Книга1").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
[/vba]


Благими намерениями выстелена дорога в АД.
 
Ответить
Сообщение
Нужно чтобы данные собирались циклом

добрый день!
а если просто транспонировать ?
[vba]
Код
Windows("1.xlsx.xlsm").Activate
    Range("A1:W40").Copy
    Windows("Книга1").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
[/vba]

Автор - K-SerJC
Дата добавления - 05.09.2019 в 10:09
WaMii Дата: Четверг, 05.09.2019, 11:07 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
K-SerJC,
День добрый!
Насколько я поняла, необходимо чтобы данные циклом собирались с разных страниц, поэтому думаю это не подойдет


Сообщение отредактировал WaMii - Четверг, 05.09.2019, 11:08
 
Ответить
СообщениеK-SerJC,
День добрый!
Насколько я поняла, необходимо чтобы данные циклом собирались с разных страниц, поэтому думаю это не подойдет

Автор - WaMii
Дата добавления - 05.09.2019 в 11:07
boa Дата: Пятница, 06.09.2019, 10:48 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 407
Репутация: 115 ±
Замечаний: 0% ±

2013, 365
DAN123,
[vba]
Код
Sub CopyAndTransposeTable()
  Dim sh As Worksheet
  Dim myArr(), LastRow&
  For Each sh In ThisWorkbook.Sheets
    If sh.Name <> ActiveSheet.Name Then
      myArr = sh.UsedRange.Offset(, 1).Resize(, sh.UsedRange.Columns.Count - 1)
      myArr = TransposeArray(myArr)
      With ActiveSheet
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
        .Cells(LastRow, 2).Resize(UBound(myArr, 1), UBound(myArr, 2)) = myArr
        .Cells(LastRow, 1).Resize(UBound(myArr, 1)) = sh.Name
      End With
    End If
  Next sh
End Sub

Function TransposeArray(ByRef SourceArray() As Variant) As Variant
    Dim X1&: X1 = LBound(SourceArray, 1)
    Dim X2&: X2 = UBound(SourceArray, 1)
    Dim Y1&: Y1 = LBound(SourceArray, 2)
    Dim Y2&: Y2 = UBound(SourceArray, 2)
    Dim TempArray As Variant, i&, j&
    ReDim TempArray(Y1 To Y2, X1 To X2)
    For i = X1 To X2
        For j = Y1 To Y2
            TempArray(j, i) = SourceArray(i, j)
        Next j
    Next i
    TransposeArray = TempArray
End Function
[/vba]
К сообщению приложен файл: 5343951.xlsm(30.8 Kb)


 
Ответить
СообщениеDAN123,
[vba]
Код
Sub CopyAndTransposeTable()
  Dim sh As Worksheet
  Dim myArr(), LastRow&
  For Each sh In ThisWorkbook.Sheets
    If sh.Name <> ActiveSheet.Name Then
      myArr = sh.UsedRange.Offset(, 1).Resize(, sh.UsedRange.Columns.Count - 1)
      myArr = TransposeArray(myArr)
      With ActiveSheet
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
        .Cells(LastRow, 2).Resize(UBound(myArr, 1), UBound(myArr, 2)) = myArr
        .Cells(LastRow, 1).Resize(UBound(myArr, 1)) = sh.Name
      End With
    End If
  Next sh
End Sub

Function TransposeArray(ByRef SourceArray() As Variant) As Variant
    Dim X1&: X1 = LBound(SourceArray, 1)
    Dim X2&: X2 = UBound(SourceArray, 1)
    Dim Y1&: Y1 = LBound(SourceArray, 2)
    Dim Y2&: Y2 = UBound(SourceArray, 2)
    Dim TempArray As Variant, i&, j&
    ReDim TempArray(Y1 To Y2, X1 To X2)
    For i = X1 To X2
        For j = Y1 To Y2
            TempArray(j, i) = SourceArray(i, j)
        Next j
    Next i
    TransposeArray = TempArray
End Function
[/vba]

Автор - boa
Дата добавления - 06.09.2019 в 10:48
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Транспортировка строк в столбцы и наоборот (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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