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

Вход

Регистрация

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

 

= Мир MS Excel/Редизайнер таблицы с сохранением форматирования - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Редизайнер таблицы с сохранением форматирования (Макросы/Sub)
Редизайнер таблицы с сохранением форматирования
Ru1- Дата: Среда, 10.08.2016, 01:00 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 1 ±
Замечаний: 40% ±

Excel 2010
Добрый вечер!

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

Файл прикладываю.

Спасибо!
С уважением, Михаил
К сообщению приложен файл: redesigner_exam.xls (29.5 Kb)
 
Ответить
СообщениеДобрый вечер!

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

Файл прикладываю.

Спасибо!
С уважением, Михаил

Автор - Ru1-
Дата добавления - 10.08.2016 в 01:00
Ru1- Дата: Четверг, 11.08.2016, 17:22 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 1 ±
Замечаний: 40% ±

Excel 2010
Нашел похожее решение, но оно работает только для одномерной таблицы и транспонирует строку не полностью, а до последнего ненулевого значения в строке.



Подскажите пожалуйста, как можно скорректировать код, чтобы можно было выбрать размерность таблицы (кол-во строк сверху и слева) и строка копировалась в столбец полностью?

С уважением, Михаил


Сообщение отредактировал Manyasha - Пятница, 12.08.2016, 12:18
 
Ответить
СообщениеНашел похожее решение, но оно работает только для одномерной таблицы и транспонирует строку не полностью, а до последнего ненулевого значения в строке.



Подскажите пожалуйста, как можно скорректировать код, чтобы можно было выбрать размерность таблицы (кол-во строк сверху и слева) и строка копировалась в столбец полностью?

С уважением, Михаил

Автор - Ru1-
Дата добавления - 11.08.2016 в 17:22
RAN Дата: Четверг, 11.08.2016, 19:47 | Сообщение № 3
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Этот макрос модифицировать сложно, а вот оригинал запросто.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеЭтот макрос модифицировать сложно, а вот оригинал запросто.

Автор - RAN
Дата добавления - 11.08.2016 в 19:47
Ru1- Дата: Пятница, 12.08.2016, 12:14 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 1 ±
Замечаний: 40% ±

Excel 2010
RAN, Спасибо за ответ!

Получилось сделать работающий вариант из двух решений, но он достаточно медленно работает.

Вот код:
[vba]
Код
Sub RedesignerXX()
Dim i As Long
Dim hc As Integer, hr As Integer
Dim ns As Worksheet
Dim inpdata, r, c, j, k

hr = InputBox("Сколько строк с подписями сверху?")
hc = InputBox("Сколько столбцов с подписями слева?")

Application.ScreenUpdating = False

i = 1
Set inpdata = Selection
Set ns = Worksheets.Add

For r = (hr + 1) To inpdata.Rows.Count
For c = (hc + 1) To inpdata.Columns.Count
For j = 1 To hc
'' ns.Cells(i, j) = inpdata.Cells(r, j)

inpdata.Cells(r, j).Copy
ns.Cells(i, j).PasteSpecial xlPasteAll, , , True

Next j

For k = 1 To hr

inpdata.Cells(k, c).Copy
ns.Cells(i, j + k - 1).PasteSpecial xlPasteAll, , , True

Next k

inpdata.Cells(r, c).Copy
ns.Cells(i, j + k - 1).PasteSpecial xlPasteAll, , , True

i = i + 1
Next c
Next r
End Sub
[/vba]

С уважением, Михаил


Сообщение отредактировал Manyasha - Пятница, 12.08.2016, 12:18
 
Ответить
СообщениеRAN, Спасибо за ответ!

Получилось сделать работающий вариант из двух решений, но он достаточно медленно работает.

Вот код:
[vba]
Код
Sub RedesignerXX()
Dim i As Long
Dim hc As Integer, hr As Integer
Dim ns As Worksheet
Dim inpdata, r, c, j, k

hr = InputBox("Сколько строк с подписями сверху?")
hc = InputBox("Сколько столбцов с подписями слева?")

Application.ScreenUpdating = False

i = 1
Set inpdata = Selection
Set ns = Worksheets.Add

For r = (hr + 1) To inpdata.Rows.Count
For c = (hc + 1) To inpdata.Columns.Count
For j = 1 To hc
'' ns.Cells(i, j) = inpdata.Cells(r, j)

inpdata.Cells(r, j).Copy
ns.Cells(i, j).PasteSpecial xlPasteAll, , , True

Next j

For k = 1 To hr

inpdata.Cells(k, c).Copy
ns.Cells(i, j + k - 1).PasteSpecial xlPasteAll, , , True

Next k

inpdata.Cells(r, c).Copy
ns.Cells(i, j + k - 1).PasteSpecial xlPasteAll, , , True

i = i + 1
Next c
Next r
End Sub
[/vba]

С уважением, Михаил

Автор - Ru1-
Дата добавления - 12.08.2016 в 12:14
Manyasha Дата: Пятница, 12.08.2016, 12:19 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Ru1-, код следует оформлять кнопкой #, а не класть под спойлер.


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеRu1-, код следует оформлять кнопкой #, а не класть под спойлер.

Автор - Manyasha
Дата добавления - 12.08.2016 в 12:19
SLAVICK Дата: Пятница, 12.08.2016, 13:30 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

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

Этот макрос модифицировать сложно

Можно, хоть и сложно %) :D .
Постарался оптимизировать скорость, путем копирования полных справочников и строк - а не отдельно каждой ячейки. Но при работе с диапазонами - все равно долго.

ns.Cells(i, j).PasteSpecial xlPasteAll, , , True

Вот это зря... если будут формулы в таблице, то %) %) (см. пример) в примере мой и Ваш макросы.
заменил файл
заменил файл еще раз
К сообщению приложен файл: 2224642-1-3-.xls (69.0 Kb)


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

Этот макрос модифицировать сложно

Можно, хоть и сложно %) :D .
Постарался оптимизировать скорость, путем копирования полных справочников и строк - а не отдельно каждой ячейки. Но при работе с диапазонами - все равно долго.

ns.Cells(i, j).PasteSpecial xlPasteAll, , , True

Вот это зря... если будут формулы в таблице, то %) %) (см. пример) в примере мой и Ваш макросы.
заменил файл
заменил файл еще раз

Автор - SLAVICK
Дата добавления - 12.08.2016 в 13:30
Ru1- Дата: Пятница, 12.08.2016, 16:27 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 1 ±
Замечаний: 40% ±

Excel 2010
Manyasha, Хорошо, в следующий раз учту.
SLAVICK, Большое спасибо за помощь!

Тему можно закрывать.

С уважением, Михаил
 
Ответить
СообщениеManyasha, Хорошо, в следующий раз учту.
SLAVICK, Большое спасибо за помощь!

Тему можно закрывать.

С уважением, Михаил

Автор - Ru1-
Дата добавления - 12.08.2016 в 16:27
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Редизайнер таблицы с сохранением форматирования (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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