ВСЕМ ДОБРОГО ВРЕМЕНИ ! Такой вопрос – КАК ПЕРЕНЕСТИ ДАННЫЕ из Таблицы с Объединенными ячейками в Обычную Таблицу с нормальными ячейками ? Прислали много файлов EXCEL с Отчетами из районной организации и в каждом файле по несколько таблиц – и все ячейки в таблицах ОБЪЕДИНЕННЫЕ (по 2-5 строк и до 4-6 столбцов в ОДНОЙ ЯЧЕЙКЕ !!!) И нужно эти данные отправить в Вышестоящую организацию – НО в НОРМАЛЬНОМ ВИДЕ – в Таблицах с обычными ячейками
Рис.1 - Файл-исходник – Как видно на картинке – Ячейка состоит из 4-х столбцов и 4-х строк !.. И более того – Всем Ячейкам Присвоены Имена … типа gr2r1str102 – что означает По-Русски – Графа-1, Раздел-1 (Таблица-1), Строка-102
И на Рис.2 – показано Каким должен быть Файл-Готовый для отправки – Обычная Стандартная форма Excel
Обычные способы Копирования и Спец.Вставки нужного результата не дают !.. Подскажите какой-нибудь способ / метод – КАК ПЕРЕНЕСТИ ДАННЫЕ из Объединенных таблиц в Обычные Таблицы – ЛЕГКИМ ДОСТУПНЫМ И УДОБНЫМ СПОСОБОМ ! ЗАРАНЕЕ БЛАГОДАРЮ !
ВСЕМ ДОБРОГО ВРЕМЕНИ ! Такой вопрос – КАК ПЕРЕНЕСТИ ДАННЫЕ из Таблицы с Объединенными ячейками в Обычную Таблицу с нормальными ячейками ? Прислали много файлов EXCEL с Отчетами из районной организации и в каждом файле по несколько таблиц – и все ячейки в таблицах ОБЪЕДИНЕННЫЕ (по 2-5 строк и до 4-6 столбцов в ОДНОЙ ЯЧЕЙКЕ !!!) И нужно эти данные отправить в Вышестоящую организацию – НО в НОРМАЛЬНОМ ВИДЕ – в Таблицах с обычными ячейками
Рис.1 - Файл-исходник – Как видно на картинке – Ячейка состоит из 4-х столбцов и 4-х строк !.. И более того – Всем Ячейкам Присвоены Имена … типа gr2r1str102 – что означает По-Русски – Графа-1, Раздел-1 (Таблица-1), Строка-102
И на Рис.2 – показано Каким должен быть Файл-Готовый для отправки – Обычная Стандартная форма Excel
Обычные способы Копирования и Спец.Вставки нужного результата не дают !.. Подскажите какой-нибудь способ / метод – КАК ПЕРЕНЕСТИ ДАННЫЕ из Объединенных таблиц в Обычные Таблицы – ЛЕГКИМ ДОСТУПНЫМ И УДОБНЫМ СПОСОБОМ ! ЗАРАНЕЕ БЛАГОДАРЮ !vitareiki
Здравствуйте. Выделите всё--снимите объединение--выделите строку с полностью забитыим данными--F5--выделить...--пустые ячейки--удалить столбцы. Также проделайте для удаления пустых строк.
Здравствуйте. Выделите всё--снимите объединение--выделите строку с полностью забитыим данными--F5--выделить...--пустые ячейки--удалить столбцы. Также проделайте для удаления пустых строк.gling
gling, Спасибо за совет ! - В принципе некоторые таблицы так и делали - Только в ручную удаляли столбцы и строки Но в вашем способе есть существенный МИНУС - способ можно использовать при всех полностью заполненных ячейках таблицы !!! Если в ячейках значений нет - ТО ВМЕСТЕ с Ненужными Пустыми строчками можно удалить и Пустые нужные строки входящие в состав таблицы Надо бы как-то снять выделение с Нужных строк чтобы Не удалились вместе с Пустыми Ненужными строками
gling, Спасибо за совет ! - В принципе некоторые таблицы так и делали - Только в ручную удаляли столбцы и строки Но в вашем способе есть существенный МИНУС - способ можно использовать при всех полностью заполненных ячейках таблицы !!! Если в ячейках значений нет - ТО ВМЕСТЕ с Ненужными Пустыми строчками можно удалить и Пустые нужные строки входящие в состав таблицы Надо бы как-то снять выделение с Нужных строк чтобы Не удалились вместе с Пустыми Ненужными строкамиvitareiki
У вас всегда есть данные в строке 17 (заголовок) столбце Y (см. рисунок) по ним и выделяйте. Даже если данных в таблице не будет заголовки останутся, а это вам и нужно.
У вас всегда есть данные в строке 17 (заголовок) столбце Y (см. рисунок) по ним и выделяйте. Даже если данных в таблице не будет заголовки останутся, а это вам и нужно.gling
Sub Макрос1() Selection.UnMerge Dim c As Range Dim x For x = Selection.Columns.Count To 1 Step -1 Set c = Selection.Columns(x) If Application.WorksheetFunction.CountBlank(c) = c.Rows.Count Then c.EntireColumn.Delete End If Next
For x = Selection.Rows.Count To 1 Step -1 Set c = Selection.Rows(x) If Application.WorksheetFunction.CountBlank(c) = c.Columns.Count Then c.EntireRow.Delete End If Next
End Sub
[/vba]
vitareiki, Как вариант VBA: [vba]
Код
Sub Макрос1() Selection.UnMerge Dim c As Range Dim x For x = Selection.Columns.Count To 1 Step -1 Set c = Selection.Columns(x) If Application.WorksheetFunction.CountBlank(c) = c.Rows.Count Then c.EntireColumn.Delete End If Next
For x = Selection.Rows.Count To 1 Step -1 Set c = Selection.Rows(x) If Application.WorksheetFunction.CountBlank(c) = c.Columns.Count Then c.EntireRow.Delete End If Next
Sub Макрос1() Dim ps&, pk&, i& Application.ScreenUpdating = False ps = Range("AD" & Rows.Count).End(xlUp).Row Range("AD7:BI" & ps).Copy Sheets("Лист1").Range("B3") Sheets("Лист1").Select ActiveSheet.UsedRange.UnMerge ActiveSheet.UsedRange.Columns(1).SpecialCells(4).EntireRow.Delete pk = Cells(3, Columns.Count).End(xlToLeft).Column + 3 For i = pk To 2 Step -1 If Application.CountA(Columns(i)) = 0 Then Columns(i).Delete Next i Range(ActiveSheet.UsedRange.Address).Borders.Weight = xlThin Application.ScreenUpdating = True End Sub
[/vba]
Пример макросом на отдельный лист. [vba]
Код
Sub Макрос1() Dim ps&, pk&, i& Application.ScreenUpdating = False ps = Range("AD" & Rows.Count).End(xlUp).Row Range("AD7:BI" & ps).Copy Sheets("Лист1").Range("B3") Sheets("Лист1").Select ActiveSheet.UsedRange.UnMerge ActiveSheet.UsedRange.Columns(1).SpecialCells(4).EntireRow.Delete pk = Cells(3, Columns.Count).End(xlToLeft).Column + 3 For i = pk To 2 Step -1 If Application.CountA(Columns(i)) = 0 Then Columns(i).Delete Next i Range(ActiveSheet.UsedRange.Address).Borders.Weight = xlThin Application.ScreenUpdating = True End Sub
еще вариант макроса выделяем таблицу, жмем на кнопку [vba]
Код
Sub d() Dim r1 As Range Application.ScreenUpdating = 0: Application.EnableEvents = 0 With Selection .UnMerge On Error GoTo er Set r1 = .RowDifferences(.Find(Empty)) r1.EntireRow.Hidden = 1 .SpecialCells(12).EntireRow.Delete .EntireRow.Hidden = 0 r1.EntireColumn.Hidden = 1 .SpecialCells(12).EntireColumn.Delete .EntireColumn.Hidden = 0 End With er: Application.ScreenUpdating = 1: Application.EnableEvents = 1 End Sub
[/vba]
еще вариант макроса выделяем таблицу, жмем на кнопку [vba]
Код
Sub d() Dim r1 As Range Application.ScreenUpdating = 0: Application.EnableEvents = 0 With Selection .UnMerge On Error GoTo er Set r1 = .RowDifferences(.Find(Empty)) r1.EntireRow.Hidden = 1 .SpecialCells(12).EntireRow.Delete .EntireRow.Hidden = 0 r1.EntireColumn.Hidden = 1 .SpecialCells(12).EntireColumn.Delete .EntireColumn.Hidden = 0 End With er: Application.ScreenUpdating = 1: Application.EnableEvents = 1 End Sub
gling, and_evg, Wasilich, krosav4ig БЛАГОДАРЮ ЗА СОВЕТЫ И МАКРОСЫ !.. - Очень Интересные варианты Макросы Посмотрю и Попробую на работе ! ВСЕХ БЛАГ !
P.S. Еще один вопрос - подсказали что можно попробовать воспользоваться функцией
Код
=ИНДЕКС(таблица;СТРОКА()*4;СТОЛБЕЦ()*4)
Но как ей воспользоваться не совсем понятно ... Может кто-нибудь подсказать как ее можно использовать на Примере в Файле приложенном к сообщению !
gling, and_evg, Wasilich, krosav4ig БЛАГОДАРЮ ЗА СОВЕТЫ И МАКРОСЫ !.. - Очень Интересные варианты Макросы Посмотрю и Попробую на работе ! ВСЕХ БЛАГ !
P.S. Еще один вопрос - подсказали что можно попробовать воспользоваться функцией
Код
=ИНДЕКС(таблица;СТРОКА()*4;СТОЛБЕЦ()*4)
Но как ей воспользоваться не совсем понятно ... Может кто-нибудь подсказать как ее можно использовать на Примере в Файле приложенном к сообщению !vitareiki
еще вариант макроса выделяем таблицу, жмем на кнопку
Здравствуйте, в вашем макросе возможно изменить последовательное соединение объединенных ячеек? У меня похожая задача с перемещением из объединенных ячеек в однострочные, но между некоторыми позициями есть пробелы и ваш макрос их не учитывает и все делает последовательно только там где есть числа. Прикрепил файл с таблицей.
еще вариант макроса выделяем таблицу, жмем на кнопку
Здравствуйте, в вашем макросе возможно изменить последовательное соединение объединенных ячеек? У меня похожая задача с перемещением из объединенных ячеек в однострочные, но между некоторыми позициями есть пробелы и ваш макрос их не учитывает и все делает последовательно только там где есть числа. Прикрепил файл с таблицей.lightingkai
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
