Транспонирование листа

@Hikitosik · Регистрация: 05.12.2016

Студворк — интернет-сервис помощи студентам

Снова добрый день)))
В этот раз заинтересовала задача транспонирования в Excel с помощью макроса. На разных форумах много разных кодов. Например:

Visual Basic
1
2
3
4
5
6
7
Sub TRP()
    Workbooks.Add xlWBATWorksheet
    ActiveSheet.Name = "Ваше_Имя_Листа"
    ThisWorkbook.Sheets("Таблица").Range("A4:AH5003").Copy
    ActiveSheet.[A1].PasteSpecial Transpose:=True
    ActiveWorkbook.SaveAs "Ваше_Имя_Книги.xlsx"
End Sub

Люди транспонируют какой-то определенный диапазон ячеек. Моя же проблема состоит в том, что я заранее не знаю, сколько у меня будет столбцов. Строчек же всегда будет 266. Как обойти эту проблему? Задумывался, чтобы заранее посчитать количество столбцов. Но как-то эта идея меня не особо обрадовала.
Заранее спасибо за любой ответ)

@Burk · 08.08.2019, 13:37

Hikitosik, вот вам любой ответ - ну вам бы уже пора пользоваться поисковиком Найти последнюю заполненную строку/столбец вба. Миллион ответов.

@Hikitosik · 08.08.2019, 16:15 **[ТС]**

Я хотел просто метод без нахождения последних столбцов. Но если отталкиваться от него у меня возникает несколько вопросов
Вот эта строка находит последний столбец

Visual Basic
1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Не понятно вот что:
1) Как в данном случае указать книгу и лист, с которым работать нужно
2) Каким образом прописать диапазон с переменной

Добавлено через 1 час 13 минут
Со вторым вопросом, вроде, разобрался (в пятой строчке вставил два амперсанда). Получился такой код:

Visual Basic
1
2
3
4
5
6
7
8
Sub Транспонирование()
    Workbooks.Add xlWBATWorksheet
    ActiveSheet.Name = "archive"
    t = Cells(1, Columns.Count).End(xlToLeft).Column
    ThisWorkbook.Sheets("NewFile").Range("A2:" & t & "266").Copy
    ActiveSheet.[A1].PasteSpecial Transpose:=True
    ActiveWorkbook.SaveAs "C:\Users\ND\Desktop\test\DataNew.xlsx"
End Sub

Но что-то ломается и выдаёт такую ошибку:

Visual Basic
1
2
3
Run-time error '9':
 
Subscript out of range

Так же остался вопрос с указанием книги и листа при подсчёте столбцов.

Добавлено через 8 минут
Нашёл что-то подобное, но там ситуация совсем наоборот. Под свою задачу переделать не смог

Макрос для транспонирования значений из строк в столбцы с копированием значений из исходной строки

@Burk · 08.08.2019, 16:16

Hikitosik, скопировал ваш макрос, вставил в свой, первый попавшийся файл, запустил - всё сработало. Вам только надо заменить копируемый диапазон

Visual Basic
1
 ThisWorkbook.Sheets(ВашЛист).Range(Cells(4,1),Cells(266,lastrow)).Copy

если нужно копировать в какую-то другую книгу, то активировать нужную страницу этой книги
Workbooks(НужнаяКнига),Sheets(НужныйЛист ).Activate
после ставите ваш PasteSpecial
Или я не так понял вопрос?

@Hikitosik · 08.08.2019, 16:27 **[ТС]**

Хотелось указать книгу и лист в котором будет происходить транспонирование. Потому что хочется запускать этот макрос из любого файла. А макрос в свою очередь работет с конкретным файлом, например, "file.xlsx"

@Burk · 08.08.2019, 16:32

или может файл пришлете

Добавлено через 5 минут
Hikitosik, макрос находится в книге с расширением xlsm, какой это файл, а то у вас Thisworkbook и добавленная, не понять какая, книга.

Сообщение от Hikitosik

Хотелось указать книгу и лист в котором будет происходить транспонирование

так я же в предыдущем послании написал

Visual Basic
1
Workbooks(НужнаяКнига).Sheets(НужныйЛист).Activate

@Hikitosik · 08.08.2019, 16:40 **[ТС]**

Высылаю такой файл. В данном случае строчек у него константно 119, а столбцы могут добавляться в других версиях документа. Саму эту таблицу нужно транспонировать. Сохранить транспонированную матрицу можно на этот лист или создать новый и туда положить - это не принципиально

@Burk · 08.08.2019, 16:42

запускать этот макрос из любого файла
а я и запустил этот макрос из любого своего и нет проблем. А у вас они в каком месте?
попробую теперь ваш, а макрос то где? Вы уж пришлите с вашим макросом, только сохранить с расширением xlsm

@Hikitosik · 08.08.2019, 17:00 **[ТС]**

Извините))
Храню просто макросы в другой книге. Высылаю

Добавлено через 5 минут
Пишет, что некорректный файл пытаюсь загрузить

Добавлено через 1 минуту
формат .xlsm закинуть на сайт не получается

@Hikitosik · 08.08.2019, 17:04 **[ТС]**

Отправляю заархивированным

@Burk · 08.08.2019, 17:15

Hikitosik, посылаю ваш файл с транспонированием на второй лист. Пока не нужно новых книг, надо в этой книге отладить. Все получилось как и было написано в макросе, только вряд-ли это то, что вы хотели. Заголовки тоже транспонировались и очень некрасиво, думайте. Надо просто создать лист с заголовками для транспонированной матрицы, и переносить туда только транспонированные данные

@Hikitosik · 09.08.2019, 12:36 **[ТС]**

Добрый день еще раз)))

При создании на рабочем столе файла эксель - данный код работает, когда запущена книга

Однако, когда я привинчиваю код к интересующей меня папке с файлами - всё ломается. Вот код, который я использую:

Visual Basic
1
2
3
4
5
6
7
Sub Transpose()
    Workbooks("D:\QVProjects\ND\NewFile.xlsx").Sheets("archive").Activate
    t = Cells(22, Columns.Count).End(xlToLeft).Column
    Range(Cells(2, 1), Cells(265, t)).Copy
    Sheets(3).Activate
    ActiveSheet.[A1].PasteSpecial Transpose:=True
End Sub

Вот ошибка которую показывает:

Visual Basic
1
2
3
Run-time error '9':
 
Subscript out of range

И высвечивает желтым вторую строчку макроса, а именно:

Visual Basic
1
 Workbooks("D:\QVProjects\ND\NewFile.xlsx").Sheets("archive").Activate

Боролся с этим весь вчерашний вечер и начало сегодняшнего дня, ничего не выходит. По началу думал, что неправильно указан путь к файлу, но уже перепробовал все комбинации. Что делать? Помогите, пожалуйста

Добавлено через 25 минут
Передо мной стоит более обширная задача. Я её реализовал. Последний этап - транспонировать таблицу из этого файла, чтобы он правильно считывался в другой программе

@Burk · 09.08.2019, 12:54

Hikitosik, но ведь совершенно неясно в каком файле находится макрос, у меня складывается впечатление, что он находится в одном файле, потом вы вызваете второй (из него запускается макрос первого), который по вашим предположениям,станет основным вместо первого, а значения берутся из третьего. Так вот чтобы не гадать, присылайте ваши (все файлы), один с макросом и опишите порядок их загрузки. Задача-то несложная, главное понять чего и как надо

Добавлено через 5 минут
Ошибка, изображенная вами, ничего не значит без файла и указания строки ошибки, которая должна произойти и у меня при запуске вашей задачи

Добавлено через 9 минут
а вот, когда выскакивает ошибка, то на экране появляется меню, нажать на Debug и выделит желтым строку кода с ошибкой. При наведении мышью на переменную в этом макросе можно увидеть текущее значение её. Это помогает в нахождении ошибок.

@Hikitosik · 09.08.2019, 12:58 **[ТС]**

Все макросы лежат в файле Макросы.xlsm

Суть состоит в том, что сначала работает макрос Последний_файл() и создает новую книгу NewFile.xlsx, куда копирует данные из самого свежего фала типа *file*.xlsx

Далее необходимо в этом NewFile.xlsx просто транспонировать лист и сохранить туда же. Сам вид заголовков не интересует, потому что нужны только данные для считывания

@Hikitosik · 09.08.2019, 13:05 **[ТС]**

Задача тривиальная, а разобраться что-то не могу

При наведении на жёлтую строку не пишет текущее значение

@Burk · 09.08.2019, 13:43

Hikitosik, скопировал ваши файлы в папку D:\Foler (ну не создавать же на своем компе ашу длинную), запустил ваш исходный макрос. Всё Ок. А вот Transpose пришлось подправить. Кстати, откажитесь от привычки называть свои переменные и функции стандартными именами, что букв в алфавите не хватает? После правки всё Ок. Папка в макросе тоже моя.
Не надо копировать и записывать в одну папку. Если не нужна исходная страница, то после транспонирования удалите её из файла.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub Transpose()
    Workbooks.Open "D:\Folder\NewFile.xlsx"
    Workbooks("NewFile.xlsx").Sheets("archive").Activate
     Sheets.Add After:=Sheets(1)
    Sheets("archive").Activate
 
    t = Cells(22, Columns.Count).End(xlToLeft).Column
    Range(Cells(2, 1), Cells(265, t)).Copy
    Sheets(2).Activate
    ActiveSheet.[A1].PasteSpecial Transpose:=True
End Sub

@Hikitosik · 09.08.2019, 14:13 **[ТС]**

Спасибо огромное, всё заработало))))
Безмерно рад и счастлив!!!!
Теперь пошёл даль изучать азы))

Добавлено через 2 минуты
Только немного непонятно, этот новый лист сохранился в книге или нужно ещё что-то дописать?)))

@Burk · 09.08.2019, 14:22

Сообщение от Hikitosik

При наведении на жёлтую строку не пишет текущее значение

наводить надо не на строку, а на переменные в макросе и не обязательно в этой строке.

Добавлено через 3 минуты
Hikitosik, лист конечно сохранился, после работы макроса он и открыт перед вами.
но сохранять файл в новом виде решать вам. Можете сохранение поставить в макрос

@Hikitosik · 09.08.2019, 14:43 **[ТС]**

Просто после того, как я пытаюсь закрыть выведенный файл мне предлагает сохранить изменения

Если нажимаю нет, то при ручном открытии файла уже не отображается лист с новыми данными

@Burk · 09.08.2019, 14:45

там у меня впопыхах не то набрано, надо: Не надо копировать и записывать в один лист

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	08.08.2019, 13:37
	Hikitosik, вот вам любой ответ - ну вам бы уже пора пользоваться поисковиком Найти последнюю заполненную строку/столбец вба. Миллион ответов. 1

@Hikitosik 0 / 0 / 0 Регистрация: 05.12.2016 Сообщений: 86
	08.08.2019, 16:27 [ТС]
	Хотелось указать книгу и лист в котором будет происходить транспонирование. Потому что хочется запускать этот макрос из любого файла. А макрос в свою очередь работет с конкретным файлом, например, "file.xlsx" 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	08.08.2019, 16:42
	запускать этот макрос из любого файла а я и запустил этот макрос из любого своего и нет проблем. А у вас они в каком месте? попробую теперь ваш, а макрос то где? Вы уж пришлите с вашим макросом, только сохранить с расширением xlsm 1

@Hikitosik 0 / 0 / 0 Регистрация: 05.12.2016 Сообщений: 86
	08.08.2019, 17:00 [ТС]
	Извините)) Храню просто макросы в другой книге. Высылаю Добавлено через 5 минут Пишет, что некорректный файл пытаюсь загрузить Добавлено через 1 минуту формат .xlsm закинуть на сайт не получается 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	09.08.2019, 12:54
	Hikitosik, но ведь совершенно неясно в каком файле находится макрос, у меня складывается впечатление, что он находится в одном файле, потом вы вызваете второй (из него запускается макрос первого), который по вашим предположениям,станет основным вместо первого, а значения берутся из третьего. Так вот чтобы не гадать, присылайте ваши (все файлы), один с макросом и опишите порядок их загрузки. Задача-то несложная, главное понять чего и как надо Добавлено через 5 минут Ошибка, изображенная вами, ничего не значит без файла и указания строки ошибки, которая должна произойти и у меня при запуске вашей задачи Добавлено через 9 минут а вот, когда выскакивает ошибка, то на экране появляется меню, нажать на Debug и выделит желтым строку кода с ошибкой. При наведении мышью на переменную в этом макросе можно увидеть текущее значение её. Это помогает в нахождении ошибок. 1

@Hikitosik 0 / 0 / 0 Регистрация: 05.12.2016 Сообщений: 86
	09.08.2019, 13:05 [ТС]
	Задача тривиальная, а разобраться что-то не могу При наведении на жёлтую строку не пишет текущее значение 0

@Hikitosik 0 / 0 / 0 Регистрация: 05.12.2016 Сообщений: 86
	09.08.2019, 14:13 [ТС]
	Спасибо огромное, всё заработало)))) Безмерно рад и счастлив!!!! Теперь пошёл даль изучать азы)) Добавлено через 2 минуты Только немного непонятно, этот новый лист сохранился в книге или нужно ещё что-то дописать?))) 0

@Hikitosik 0 / 0 / 0 Регистрация: 05.12.2016 Сообщений: 86
	09.08.2019, 14:43 [ТС]
	Просто после того, как я пытаюсь закрыть выведенный файл мне предлагает сохранить изменения Если нажимаю нет, то при ручном открытии файла уже не отображается лист с новыми данными 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	09.08.2019, 14:45
	там у меня впопыхах не то набрано, надо: Не надо копировать и записывать в один лист 0

Транспонирование листа

Решение