Транспонировать из горизонтали в вертикаль.

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Транспонировать из горизонтали в вертикаль. (Формулы/Formulas)

Mark1976

Дата: Четверг, 20.08.2026, 07:57 | Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 866

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Здравствуйте. Подскажите решение, как быстро (формула, макрос) транспонировать текст из горизонтали в вертикаль? Результат на листе "так надо". Заранее спасибо.

К сообщению приложен файл: gruppa_ksg_tn_mnn.xlsx (12.7 Kb)

Ответить

Nic70y

Дата: Четверг, 20.08.2026, 09:16 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 9281

Репутация: 2502 ±

Замечаний: 0% ±

Excel 2010

такой вариант
[vba]

Код

Sub u_736()
    Application.ScreenUpdating = False
    '..................................................................................
    aa = 5                    'левый столбец ТН
    ab = Cells(1, Columns.Count).End(xlToLeft).Column   'правый столбец ТН
    ba = 2                    'верхняя строка МНН
    bb = Cells(Rows.Count, "b").End(xlUp).Row           'нижняя строка МНН
    ca = "Рез"                    'имя листа выгрузки результата
    '..................................................................................
    For ea = ba To bb
        eb = Sheets(ca).Cells(Rows.Count, "b").End(xlUp).Row + 1 'строка вставки
        Range("b" & ea).Copy Sheets(ca).Range("a" & eb) '
        Range(Cells(ea, aa), Cells(ea, ab)).Copy
        Sheets(ca).Range("b" & eb).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Next
    Application.CutCopyMode = False
End Sub

[/vba]

К сообщению приложен файл: 18.xlsm (23.7 Kb)

Ответить

Mark1976

Дата: Четверг, 20.08.2026, 09:25 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 866

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Nic70y, здравствуйте. Спасибо за ответ. Макрос отработал всего по 2-м наименованиям МНН, у меня их 12 в файле. В других файлах другое количество.

Ответить

Nic70y

Дата: Четверг, 20.08.2026, 09:47 | Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 9281

Репутация: 2502 ±

Замечаний: 0% ±

Excel 2010

Mark1976, у меня нормально работает...

Ответить

Mark1976

Дата: Четверг, 20.08.2026, 09:57 | Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 866

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Nic70y, вот что у меня в файле после нажатия кнопки.

К сообщению приложен файл: 18_1.xlsm (24.5 Kb)

Ответить

Mark1976

Дата: Четверг, 20.08.2026, 10:00 | Сообщение № 6

Группа: Проверенные

Ранг: Ветеран

Сообщений: 866

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Nic70y, после нажатия кнопки второй раз. ТН не корректно перенесены.

Ответить

Mark1976

Дата: Четверг, 20.08.2026, 10:02 | Сообщение № 7

Группа: Проверенные

Ранг: Ветеран

Сообщений: 866

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Nic70y, к этим МНН у меня нет ТН на листе Рез.
Бевацизумаб + темозоломид
Дегареликс + олапариб
Бусерелин + олапариб
Гозерелин + олапариб
Лейпрорелин + олапариб
Лейпрорелин + олапариб
Ленватиниб + пембролизумаб
Капецитабин + ниволумаб + оксалиплатин
Олапариб + трипторелин
Кабозантиниб + ниволумаб

Ответить

Nic70y

Дата: Четверг, 20.08.2026, 10:44 | Сообщение № 8

Группа: Друзья

Ранг: Экселист

Сообщений: 9281

Репутация: 2502 ±

Замечаний: 0% ±

Excel 2010

Цитата Mark1976, 20.08.2026 в 10:00, в сообщении № 6 (

)

второй раз

ну это исправимо[vba]

Код

Sheets(ca).Columns("a:b").Clear

[/vba]

Цитата Mark1976, 20.08.2026 в 10:02, в сообщении № 7 (

)

у меня нет ТН на листе Рез.

я не знаю причину,
в файле результат

К сообщению приложен файл: 21.xlsm (26.6 Kb)

Ответить

Mark1976

Дата: Четверг, 20.08.2026, 10:55 | Сообщение № 9

Группа: Проверенные

Ранг: Ветеран

Сообщений: 866

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Может я что то не понимаю. Но у меня макрос отработал только 2 МНН (Паклитаксел + рамуцирумаб, Пембролизумаб) Паклитаксел такого МНН нет в исходной таблице.

К сообщению приложен файл: 0501670.jpg (34.3 Kb)