Редизайнер таблиц

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

Рано или поздно пользователь такой таблицы приходит к мысли, что "пусть будет не так красиво, зато можно работать" и начинает упрощать дизайн своей таблицы, приводя его в соответствие с классическими рекомендациями:

  • простая однострочная шапка, где у каждого столбца будет свое уникальное название (имя поля)
  • одна строка - одна законченная операция (сделка, продажа, проводка, проект и т.д.)
  • без объединенных ячеек
  • без разрывов в виде пустых строк и столбцов

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

Из     redesigner4.png   сделать     redesigner5.png  

В терминах баз данных правую таблицу обычно называют плоской (flat) - именно по таким таблицам лучше всего строить отчеты сводных таблиц (pivot tables) и проводить аналитику.

Преобразовать двумерную таблицу в плоскую можно при помощи простого макроса. Откройте редактор Visual Basic - в Excel 2003 и старше это меню Сервис - Макрос - Редактор Visual Basic, а в новых версиях вкладка Разработчик - Редактор Visual Basic (Developer - Visual Basic Editor) или сочетание клавиш ALT+F11. Вставьте новый модуль (Insert - Module) и скопируйте туда текст этого макроса:

Sub Redesigner()
    Dim i As Long
    Dim hc As Integer, hr As Integer
    Dim ns As Worksheet
    
    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)
            Next j
            
            For k = 1 To hr
                ns.Cells(i, j + k - 1) = inpdata.Cells(k, c)
            Next k
            
            ns.Cells(i, j + k - 1) = inpdata.Cells(r, c)
            i = i + 1
        Next c
    Next r
End Sub

После этого можно закрыть редактор VBA и вернуться в Excel. Теперь можно выделить исходную таблицу (полностью, с шапкой и первым столбцом с месяцами) и запустить наш макрос через меню Сервис - Макрос - Макросы (Tools - Macro - Macros) или нажав ALT+F8.

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

Ссылки по теме

 



Andrey Oz
10.10.2012 16:56:21
А в обратную сторону возможно сделать (редизайнер наоборот)?
Чтобы из таблицы 2 (сделать) получилась 1 (из)..
gorya
10.10.2012 16:56:48
В вашем случае "курите" сводные таблицы.
5700
10.10.2012 16:57:55
Автору спасибо!
Делюсь доработанным вариантом, сделанным для себя.
Подходит для случая, когда количество измерений по столбцам и строкам отличные от 1. Регулируется переменными RBorder (показателей в шапке по строкам) и CBorder (показателей в шапке по колонкам).
Sub Redesigner()
 Dim InVal As Variant
 Dim OutVal() As Variant
 Dim j, k, i, r, c As Long
 Dim NewSheet
 Dim RBorder, CBorder As Long
 RBorder = 1
 CBorder = 2
 i = 1
 InVal = Selection.Formula
 ReDim OutVal(1 To Selection.Count, 1 To (RBorder + CBorder + 1))
 For j = CBorder + 1 To UBound(InVal, 1)
 For k = RBorder + 1 To UBound(InVal, 2)
 If InVal(j, k) <> "" Then
 For r = 1 To RBorder
 If InVal(j, r) <> "" Then
 OutVal(i, r) = InVal(j, r)
 Else
 OutVal(i, r) = OutVal(i - 1, r)
 End If
 Next r
 For c = RBorder + 1 To RBorder + CBorder
 If InVal(c - RBorder, k) <> "" Then
 OutVal(i, c) = InVal(c - RBorder, k)
 Else
 OutVal(i, c) = OutVal(i - 1, c)
 End If
 Next c
 OutVal(i, RBorder + CBorder + 1) = InVal(j, k)
 i = i + 1
 End If
 Next k
 Next j
 Set NewSheet = Worksheets.Add
 NewSheet.Range("A1").Resize(UBound(OutVal, 1), (RBorder + CBorder + 1)).Value = OutVal
 End Sub
24.12.2012 19:09:03
Павел, очень полезный макрос, но было бы хорошо чтоб он делал преобразование не только когда имеется первый столбец 1, а больше, так сказать заданное количество столбцов перед значениями, например у меня имеется таблица вида:
РуководительРегионГруппаЯнварьФевральМартАпрельМайИюньИюльАвгустСентябрьОктябрьНоябрьДекабрь
и при использовании Вашего макроса выдаёт некорректное преобразование в плоскую таб.
Если же оставляю Только один из первых 3-х столбцов, тогда всё ок. Если будет время доработать данный макрос, было бы классно.

to 5700, а с Вашим макросом что-то не так, ругается на строку перед End Sub
04.03.2013 04:42:46
удалите из кода предпоследней строки ".Value" и все заработает ;)
16.04.2013 01:49:21
Переделал код под более универсальный случай - теперь макрос спрашивает количество строк с подписями в шапке и количество столбцов с подписями слева. Пользуйтесь :)
16.04.2013 10:07:42
Николай, спасибо за обновление! Все отлично работает!
18.04.2013 11:26:06
Спасибо большое за макрос, уже использую его в работе.
Комментирую один нюанс использования этого макроса - первая ячейка исходной "неплоской" таблицы должна быть в ячейке A1, иначе макрос начинает добавлять пустые строки.

вот ссылка на скрин
http://yadi.sk/d/zXiLkqBE48lJN
MCH
25.04.2013 12:12:15
иначе макрос начинает добавлять пустые строки
можно так исправить
Sub Redesigner()
    Dim inpdata As Range, realdata As Range, cell As Range
    Dim i As Long, c As Long, r As Long
    Dim hc As Long, hr As Long
    Dim ns As Worksheet
    
    hr = Val(InputBox("Сколько строк с подписями данных сверху"))
    hc = Val(InputBox("Сколько столбцов с подписями данных слева?"))

    Set inpdata = Selection
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    Set ns = Worksheets.Add
    
    i = 1
    For Each cell In realdata
        If cell.Value <> "" Then
            For c = 1 To hc
                ns.Cells(i, c) = inpdata.Cells(cell.Row - inpdata.Row + 1, c)
            Next c
            For r = 1 To hr
                ns.Cells(i, c + r - 1) = inpdata.Cells(r, cell.Column - inpdata.Column + 1)
            Next r
            ns.Cells(i, c + r - 1) = cell.Value
            i = i + 1
        End If
    Next cell
End Sub
MCH
25.04.2013 20:12:35
а лучше на массивах сделать, значительно быстрее получается
Sub Redesigner()
    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out(), dataArr, hcArr, hrArr
    
    hr = Val(InputBox("Сколько строк с подписями данных сверху?"))
    hc = Val(InputBox("Сколько столбцов с подписями данных слева?"))

    Set inpdata = Selection
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                k = k + 1
                For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
                For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
                out(k, c + r - 1) = dataArr(i, j)
            End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
End Sub
01.05.2013 01:11:12
Да, для больших таблиц это даст существенное ускорение. Спасибо! :)
попробовал использовать этот код - после запуска даже лист не вставляет ... может какие нибудь дополнительные манипуляции нужны?
05.08.2013 23:05:43
Данные перед запуском макроса выделяли?
22.05.2014 12:02:16
Извините, а как вывести не только заполненные ячейки, а трансформировать исходную таблицу без потерь, оставив "пусто" там, где было пусто.
Что нужно изменить в макросе, чтобы в итоговой таблице были показаны все ячейки без потерь?
MCH
23.05.2014 13:15:53
Удалите или закомментируйте строчки
If Not IsEmpty(dataArr(i, j)) Then
и
End If
23.05.2014 13:25:47
Закомментировал указанные строки и всё, что между ними, т.к. если этого не сделать, то выдает ошибку.
Итог - создает пустой лист и всё. Что надо сделать, чтобы работало, подскажите, пожалуйста!
MCH
23.05.2014 14:02:32
дополнительно, вместо строчки
ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
нужно записать
ReDim out(1 To realdata.Count, 1 To hr + hc + 1)
23.05.2014 14:13:50
В коде не силен, поэтому всё в точности, педантично, делаю по Вашим указаниям, не забывая выделить исходную таблицу. Но результат, к сожалению, тот же - создается пустой лист и тишина. Где я могу ошибаться? Подскажите, пожалуйста!
Сейчас код таков:
Sub Redesigner()
    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out(), dataArr, hcArr, hrArr
    
    hr = Val(InputBox("Ñêîëüêî ñòðîê ñ ïîäïèñÿìè äàííûõ ñâåðõó?"))
    hc = Val(InputBox("Ñêîëüêî ñòîëáöîâ ñ ïîäïèñÿìè äàííûõ ñëåâà?"))

    Set inpdata = Selection
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To realdata.Count, 1 To hr + hc + 1)
    'ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            'If Not IsEmpty(dataArr(i, j)) Then
            '   k = k + 1
            '   For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
            '   For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
            '   out(k, c + r - 1) = dataArr(i, j)
            'End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
End Sub
 
MCH
23.05.2014 20:55:08
комментарии для строк
k = k + 1
For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
out(k, c + r - 1) = dataArr(i, j)

уберите
27.05.2014 11:42:00
У меня такая же проблема.
Но теперь даже чистого листа нет. Просто ничего не происходит:(
11.06.2014 11:04:48
Спасибо, прекрасный код, именно то, что искал!!!

Немного изменил его, вместо:
   hr = Val(InputBox("Сколько строк с подписями данных сверху?"))
   hc = Val(InputBox("Сколько столбцов с подписями данных слева?"))  
    Set inpdata = Selection

сделал

   Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="Выберите обрабатываемый диапазон:", Title:="Выбор диапазона", Type:=8)
    
   hr = Val(InputBox("Сколько строк с подписями сверху?"))
   hc = Val(InputBox("Сколько столбцов с подписями слева?"))
 


Так, мне кажется, удобнее: сначала даем юзеру возможность выбрать диапазон, затем уже спрашиваем, что является заголовками в том, что он выбрал.


PS. Выигрыш во времени по сравнению с оригинальным кодом с перебором ячеек (небольшая таблица 206x13):

ячейки = 6,617188
массив = 0,0625
Попробовала. отлично работает. И на больших таблицах действительно очень быстро.
Спасибо.
Теперь бы еще код разобрать...:D
23.05.2013 21:44:05
Добрый день! Подскажите пожалуйста, а можно дописать какую-то команду, чтобы при работе макроса ячейки сохраняли свои значения (не менялся формат), а не преобразовывались в другие форматы. Например, 1/2 преобразовуется в 02.фев, а некотрые наборы цифр 44342526 преобразовываются в экспоненциальный формат и выглядят примерно так 4435262+3 (к примеру). Заранее спасибо за ответ.
26.05.2013 09:30:06
Добавьте между 19 и 20 строчками макроса команду, которая будет перед выводом данных в ячейку устанавливать для нее текстовый формат:
ns.Cells(i, c + r - 1).NumberFormat = "Text"
Тогда выгруженные в последний столбец новой таблицы данные сохранятся точно в том же виде, что и исходные (но с ними не работают мат.вычисления!)
27.05.2013 22:05:03
Добрый день!
Попробовала добавить, ппедложенную Вами команду:

Next r
ns.Cells(i, c + r - 1).NumberFormat = Text
ns.Cells(i, c + r - 1) = cell.Value

все равно не получается. Так 1/2 становится 02.янв (хотя по идее должно менять на 01.фев)...

Подскажите, пожалуйста, что не так, почему не срабатывает.

Спасибо
02.06.2013 08:15:56
Можно по-другому, проще. Замените строку
ns.Cells(i, c + r - 1) = cell.Value 

на
ns.Cells(i, c + r - 1) = "'" & cell.Value 

и все заработает.
Но имейте ввиду - все числовые значения станут текстом (т.е. с ними не будет работать математика).
V M
24.05.2013 00:42:16
Спасибо, но не получается.
Если выделить область значений и вставить в строки 2 в столбцы 3 получится результат, только пропадают цвета.
Кто-то может подсказать, как сохранить форматы.
26.05.2013 09:27:53
Цвета этот макрос не переносит - только значения.
01.06.2013 10:34:38
Николай, намекните, в какую сторону копать. Пытаюсь переписать Ваш макрос для очень больших таблиц на массивах, но с переносом формата. Так, как будто сделали cells(i,j).copy. Можно ли сохранить отдельно формат в массив (включая формат отображения ячеек, заливку, шрифт и тд) командой на манер a=range.value? Или же поместить в  массив вообще всю информацию о диапазоне, где каждый элемент массива будет содержать любые возможные параметры ячейки? Не прошу код, хотя бы намек о том возможно ли это. Заранее спасибо.
02.06.2013 08:01:47
К сожалению, выражения типа c = Range("A1:C3").Interior.ColorIndex не работают. То есть вам придется организовывать циклы для переноса данных о форматировании с каждой ячейки в массив. И для каждого типа форматирования (цвет текста, заливка, начертание, обрамления и т.д.) нужно будет делать свой массив (или делать один многомерный Variant массив, куда вручную грузить все).

если у меня в шапке не только количество, то как пользоваться универсальным макросом, чтобы он мне оставил количество, сумму, цену и т.д. в шапке, а не перевел все в столбцы?
:( скачал пример запустил макрос, количество строк ввел 2, количество столбцов 3, но красивого результата как в прикрепленном файле не получилось, либо заполняет через строку, либо просто пустой лист ... В VBA плохо разбираюсь поэтому в коде не копался, но прикрепленный пример наверное и без всяких копаний должен работать, подскажите что нужно сделать чтобы в примере после запуска макроса получался красивый результат?
05.08.2013 23:04:08
Перед запуском макроса надо выделить исходные данные (полностью, вместе с шапкой и столбцами слева).
RAN
02.12.2013 17:53:29
Сегодня понадобилось развернуть таблицу. Вспомнил про эту статью, запустил макрос.
При 1 строке с подписями макрос, в отличие от макросов МСН ,работает не корректно (сдвигает ячейки).
Посмотреть можно запустив макрос в файле-примере и указав диапазон A2:G14.

Может есть смысл пересмотреть макрос в статье?
А то не солидно получается.
03.12.2013 10:39:33
RAN, cпасибо за наводку - поправил макрос, теперь все должно быть ОК.
08.12.2013 23:26:40
Добрый день.
Пробовал коды, первый работает, а последний код МСНа при выполнении выдает ошибку "Can`t execute code in break mode" и указывает на строку

ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)

Меня это интересует так как имею таблицу 200 на 200 и вопрос производительность важен.
Задал вопрос на вашем форуме, с преобразованием таблиц как в вашем примере так и в обратную сторону.
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=53163&MID=441613&sessid=e0585c3b1c5b314aa8815dd2116a0daf&MESSAGE_TYPE=EDIT&result=edit#message441613

буду признателен за помощь.
10.12.2013 20:37:04
Добавил в код строку Application.ScreenUpdating = False - скорость увеличилась на порядок.
Обратное преобразование - это сводная таблица.
09.02.2014 21:53:20
Важно, что "слева". Еще  важнее (математически), что "справа".
И еще важнее "Обновить" и "Обновить все" один раз преобразованные Пользовательские таблицы.
Т.к.  п е р в о е  "преобразование" огромной Пользовательской таблицы  в формат Сводной  занимает десятки минут,   но  то же  самое  "Обновить" - происходит за 2-3 секунды .
Судя по датам происходящего, думаю, что имею моральное право на  ссылки ("Примеры использования"  там еще живы):
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=39628
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=44481

ПРИМ. "Придираюсь". Но, только потому, что идея, изначально предложенная здесь Николаем - наизамечательнейшая. Цены нет такой идее.
19.04.2014 09:15:52
Спасибо за добавление, Сергей! Очень в тему :)
24.07.2015 11:20:07
А как сделать так, чтобы макрос не создавал новый лист, а формировал "правильную" таблицу в действующем, заранее определенном листе, например с заданым названием.
т.е.
1. обновление "неправильной таблицы"
2. запуск макроса
3. очистка заранее определенного листа с данными предыдущей "правильной" таблицы
4. заполнение листа с обновленными данными в виде "правильной" таблицы.
Спасибо.
23.05.2014 13:59:45
Извините, файл по второй ссылке не доступен для скачивания. Это как раз то, что я ищу.
Николай, отличная и очень нужная тема для меня. Но пример не скачивается, при нажатии ссылки "Скачать пример" расположенной под заголовком происходит простое обновление текущей страницы. И больше ничего.
Может, я конечно что не так делаю...
Могла бы и вручную таблицы сделать, но боюсь, код VBA не заработает.:(
19.04.2014 09:16:28
Пардон, поправил ссылочку - теперь все скачивается.
11.07.2014 00:23:42
Вот спасибо! Иногда приходится делать подобные вещи. Делал с большего ручками с помощью какой-то матери, многократного транспонирования, «вырезать-вставить» в нужные места, ВПР, ПОИСКПОЗ и т.п.
А возможно ли то же самое сделать не с помощью макроса, а обычными формулами? И если да, то как?
21.08.2014 18:34:48
Подозреваю, что можно что-то подобное сотворить какой-нибудь трехэтажной формулой массива, которая будет уже на табличке в 100 строке вешать Excel намертво. Вот только зачем? :)
Нужно преобразовать данные из одной сводной для другой, приходится строить промежуточную таблицу. Сам делал её через редизайнер таблиц, но теперь передаю файл людям далеким от экселя, да ещё и на макросы стоит запрет. Но вы правы, всё получилось через формулы массива типа ИНДЕКС(C$6:C$61;(СТРОКА(C1)/24-0,04+1)) , ИНДЕКС(D$5:AA$5;;ЕСЛИ(ОСТАТ(СТРОКА(A1);24)=0;24;ОСТАТ(СТРОКА(A1);24))) и =ИНДЕКС(D$6:AA$61;(СТРОКА(C1)/24-0,04+1);ЕСЛИ(ОСТАТ(СТРОКА(B1);24)=0;24;ОСТАТ(СТРОКА(B1);24)))
17.02.2015 16:56:12
Низкий поклон!!!
С_П_А_С_И_Б_О !_!_!
Очень выручил и избавил от доп эмоций и выражений. Оч нужный макрос.
21.09.2015 14:48:23
Я здесь как оказывается самый необразованный: пробую ваш макрос, даже скачал ваш пример ... в обоих случаях после ввода количества строк и столбцов создается новый лист (абсолютно пустой). Я пробовал вводить меняя местами эти два количества, но результат тот же. Если не затруднит объясните что именно я делаю неправильно. Заранее спасибо
14.10.2015 11:39:40
А таблицу с исходными данными перед запуском макроса выделяете?
10.10.2015 09:35:19
Добрый день!
Макрос не хочет формировать таблицу как в примере.
Размер таблицы 404 столбца на 872 строки.
как это исправить?
14.10.2015 11:40:08
Дмитрий, не видя вашего файла помочь не смогу. Пришлите на почту - гляну, как будет минутка.
19.10.2015 21:43:29
А как сделать, что бы новая таблица заполнялась не построчно, а по столбцам. например (1,1), (2,1),(3,1),...,(1,2),(2,2),(3,2)...
22.12.2015 00:47:15
Я не понимаю до конца, как вы это делаете, но я вам несказанно благодарна за вашу удивительную помощь! :D Спасибо за то, что вы есть! :D
11.11.2016 16:57:43
Раньше решал эту задачу с помощью «Мастера сводных таблиц и диаграмм» встроенного в Excel, только вот уже не помню, может он переварить двухмерную шапку или нет?
02.12.2016 09:19:43
Помню, что решал эту проблему через сцепление в строку шапки через какой-нибудь символ (например "^"). И там хоть 10ти мерная шапка. И потом после преобразования разрезал делением на столбцы.
18.01.2017 14:26:19
Николай, как сделать, чтобы при добавлении нового листа у него было имя?
08.02.2017 09:01:24
Добавить в 14 строке команду ns.name="Отчет", например.
07.02.2017 16:28:47
Добрый День!. Вышла Новая Настройка Plex  все круто в ней работает преобразование в плоскую, но подскажите пжл Николай если я через Ctrl буду выделять две табл, и мне необходимо чтобы они преобразовались в один диапазон выдает такую ошибку в макросе.

Вот подскажите можно ли как то что то придумать?

'вытаскиваем диапазон только с данными без подписей
    Set rngData = rngSource.Offset(hr, hc).Resize(rngSource.Rows.Count - hr, rngSource.Columns.Count - hc)
08.02.2017 09:00:22
А зачем выделять с Ctrl? Макрос на это не рассчитан. Сделайте по очереди каждую таблицу - и все ОК :)
07.02.2017 22:43:30
Здравствуйте. Помогите найти решение. имеется таблица вида:
Дата             Часы     Потребление
01.01               00:00      46548
01.01               01:00      54862
...........      ......................................
31.01               24:00
и так 31 день
Эту таблицу необходимо преобразовать в вид
дата/часы    00:00      01:00 .......... 24:00
01.01            46548     54862           59765
02.01
.........
31.01
Есть ли способ это сделать  макросом или формулой?
08.02.2017 09:03:36
Вячеслав, с такими вопросами лучше на почту или форум. И приложить пример. По фотографии лечить тяжело :)
Здравствуйте :)
Успешно использую редизайнер но есть одна провлема, исходная таблица очень громоздкая и включает много пустых и нулевых значений. Помогите мне пожалуйста сделать так, чтобы при формировании итоговой таблицы автоматически удалялись строки с нулевыми или пустыми значениями.

Спасибо  
29.03.2017 09:47:17
Столкнулся с такой же проблемой:) и вот оно, решение: дописал проверку условия, если в ячейке пустое значение "", то эту строку пропустит. Единственное, нужно проверять, что значения в пустых ячейках действительно "", иногда после выгрузок из 1С могут быть символы пробела " " или другие символы, например "-"
Sub Redesigner()
    Dim i As Long
    Dim hc As Integer, hr As Integer
    Dim ns As Worksheet
     
   Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="Выберите обрабатываемый диапазон:", Title:="Выбор диапазона", Type:=8)
    
   hr = Val(InputBox("Сколько строк с подписями сверху?"))
   hc = Val(InputBox("Сколько столбцов с подписями слева?"))
     
    Application.ScreenUpdating = False
     
    i = 1
    
    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
                If inpdata.Cells(r, c) <> "" Then
                    ns.Cells(i, j) = inpdata.Cells(r, j)
                End If
            Next j
             
            For k = 1 To hr
                If inpdata.Cells(r, c) <> "" Then
                    ns.Cells(i, j + k - 1) = inpdata.Cells(k, c)
                End If
            Next k
            
            If inpdata.Cells(r, c) <> "" Then
                ns.Cells(i, j + k - 1) = inpdata.Cells(r, c)
            Else
                i = i - 1
            End If
            i = i + 1
        Next c
    Next r
End Sub
 
Ссылка на файл с примером: тут
11.03.2017 11:28:19
Здравствуйте!
Также присоединяюсь к вопросу Надежды Гвиниашвили.
Как в коде с массивом не выводить пустые строки?
Заранее спасибо за помощь.
29.03.2017 09:45:14
Вот, дописал проверку условия, если в ячейке пустое значение "", то эту строку пропустит. Единственное, нужно проверять, что значения в пустых ячейках действительно "", иногда после выгрузок из 1С могут быть символы пробела " " или другие символы, например "-"
Sub Redesigner()
    Dim i As Long
    Dim hc As Integer, hr As Integer
    Dim ns As Worksheet
     
   Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="Выберите обрабатываемый диапазон:", Title:="Выбор диапазона", Type:=8)
    
   hr = Val(InputBox("Сколько строк с подписями сверху?"))
   hc = Val(InputBox("Сколько столбцов с подписями слева?"))
     
    Application.ScreenUpdating = False
     
    i = 1
    
    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
                If inpdata.Cells(r, c) <> "" Then
                    ns.Cells(i, j) = inpdata.Cells(r, j)
                End If
            Next j
             
            For k = 1 To hr
                If inpdata.Cells(r, c) <> "" Then
                    ns.Cells(i, j + k - 1) = inpdata.Cells(k, c)
                End If
            Next k
            
            If inpdata.Cells(r, c) <> "" Then
                ns.Cells(i, j + k - 1) = inpdata.Cells(r, c)
            Else
                i = i - 1
            End If
            i = i + 1
        Next c
    Next r
End Sub
 
Ссылка на файл с примером: тут
Добрый день,
для того, чтобы на основе исходной таблицы можно было бы строить сводные таблицы, достаточно упростить ее шапку до одной строки.
Подскажите, пожалуйста, как именно надо изменить код макроса для такой цели?
Разобрался. Проще из полученной плоской заново построить сводную в нужном виде.
03.07.2017 17:22:23
Подскажите, как сделать

Исходная
Иванов
Иван1
Петр2
Саша3
Петрова
Маша1
Даша2
Глаша3

Нужно получить
вановИван1
ИвановПетр2
ИвановСаша3
ПетроваМаша1
ПетроваДаша2
ПетроваГлаша3
Работаю с огромным массивом данных, очень часто нужно решение этой проблемки.
Пока делаю вручную, по несколько часов.
Спасибо!!!!
19.07.2017 13:59:14
Добрый день! А как быть, если на исходной таблице установлен фильтр и нужно преобразовать в плоскую только видимый диапазон?
29.09.2017 15:46:16
Добрый день, Николай, не получается запустить макрос, выдается ошибка
Max
11.10.2017 15:51:31
Огромное спасибо за макрос - очень пригодился!
Подскажите, пожалуйста, как следует дополнить макрос, чтобы он переносил с исходной таблицы заголовки столбцов справа и добавлял автоматически заголовки для столбцов на базе строк из шапки (напр. "Шап1", "Шап2" и т.д.), а последний столбец озаглавил бы "Данные"? Никак не могу самостоятельно это реализовать.
Заранее благодарю.
30.07.2018 11:16:48
Здравствуйте, Николай. Редизайнер таблиц очень нужный и удобный инструмент, и здорово, что такой инструмент есть в Plex. Таблица исходная, помимо значений, может содержать ссылки, формулы и примечания. Можно ли сделать так, чтобы при изменении дизайна таблицы в новой таблице в нужных ячейках оставались примечания, если в исходной таблице в ячейке соответствующей они присутствуют?
30.07.2018 11:17:22
То же самое со ссылками, можно ли сделать так, чтобы в содержании ячейки в новой таблице с новым дизайном остались ссылки или даже формулы, если они есть в соответствующей ячейке исходной таблицы, так, чтобы они работали? Формулы могут содержать примечания.
30.07.2018 11:44:05
В идеале, чтобы пользователь мог выбрать в меню макроса, как копировать данные в новую таблицу из исходной с помощью Редизайнера таблиц - полностью со всем содержимым (с формулами и ссылками, примечаниями), только значения с примечаниями, только значения ...
30.07.2018 11:45:28
Можно ли сделать так, чтобы при копировании исходных данных в новую таблицу с помощью Редизайнера таблиц копировались не значения из исходной ячейки, а ссылки на исходные ячейки?
30.07.2018 11:50:32
Можно ли добавить возможность пропускать не только пустые ячейки, но и по условию, например, если значение равно 0?
Наверх