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

Вход

Регистрация

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

 

= Мир MS Excel/Изменить формат таблицы - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменить формат таблицы (Макросы/Sub)
Изменить формат таблицы
ZamoK Дата: Пятница, 25.11.2016, 10:05 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 214
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Доброго дня!
Хотел как-то упростить рутину, для этого надо немного поменять формат таблицы. Пробовал сделать сводную, но она сильно ругалась из-за недостатка какой-то информации, наверно где-то пустые ячейки короче у меня ничего не получилось пока, но не суть, подумал может макросом как-то, можно. ЛЮДИ помогите с реализацией! Подскажите как сделать это проще сводной или макросом, ну и если не сложно не откажусь откакого примера.Сапасиб.
К сообщению приложен файл: 333555.xls(38Kb)


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеДоброго дня!
Хотел как-то упростить рутину, для этого надо немного поменять формат таблицы. Пробовал сделать сводную, но она сильно ругалась из-за недостатка какой-то информации, наверно где-то пустые ячейки короче у меня ничего не получилось пока, но не суть, подумал может макросом как-то, можно. ЛЮДИ помогите с реализацией! Подскажите как сделать это проще сводной или макросом, ну и если не сложно не откажусь откакого примера.Сапасиб.

Автор - ZamoK
Дата добавления - 25.11.2016 в 10:05
TimSha Дата: Пятница, 25.11.2016, 10:14 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 454
Репутация: 73 ±
Замечаний: 0% ±

Excel 2013 Pro +
Подскажите как сделать

Редизайнер вам в руки! Они есть на всех основных XL-форумах... ;)


"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Ответить
Сообщение
Подскажите как сделать

Редизайнер вам в руки! Они есть на всех основных XL-форумах... ;)

Автор - TimSha
Дата добавления - 25.11.2016 в 10:14
SLAVICK Дата: Пятница, 25.11.2016, 11:07 | Сообщение № 3
Группа: Модераторы
Ранг: Старожил
Сообщений: 1834
Репутация: 613 ±
Замечаний: 0% ±

2007,2010,2013,2016
Можно формулой привести к нужному для сводной виду:
Код
=ЕСЛИ($K2="";"";ЕСЛИ(I2="";N1;I2))

А потом сводная таблица
К сообщению приложен файл: 5618747.xls(38Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеМожно формулой привести к нужному для сводной виду:
Код
=ЕСЛИ($K2="";"";ЕСЛИ(I2="";N1;I2))

А потом сводная таблица

Автор - SLAVICK
Дата добавления - 25.11.2016 в 11:07
ZamoK Дата: Пятница, 25.11.2016, 11:16 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 214
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
SLAVICK, Прошу прощенья за кривотолки, но ОБРАЗЕЦ это точто должно получится из цветной таблицы


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеSLAVICK, Прошу прощенья за кривотолки, но ОБРАЗЕЦ это точто должно получится из цветной таблицы

Автор - ZamoK
Дата добавления - 25.11.2016 в 11:16
ZamoK Дата: Пятница, 25.11.2016, 11:19 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 214
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
TimSha, пробую Редизайнер но для его работы надо переформатировать полностью все шапки, таблиц оч много и они огромны, сделать можно, но чесно очень геморойно.


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеTimSha, пробую Редизайнер но для его работы надо переформатировать полностью все шапки, таблиц оч много и они огромны, сделать можно, но чесно очень геморойно.

Автор - ZamoK
Дата добавления - 25.11.2016 в 11:19
SLAVICK Дата: Пятница, 25.11.2016, 11:19 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 1834
Репутация: 613 ±
Замечаний: 0% ±

2007,2010,2013,2016
это точто должно получится из цветной таблицы

тогда TimSha, верно написал
Редизайнер вам в руки

у нас он тоже есть даже с видеоуроком
Добавлено:
Правда, поскольку у Вас первоначальная таблица некорректно составлена - нужно еще допилить разультат редизайнера несколькими формулами - см пример.
К сообщению приложен файл: 5618747-1-.xlsx(21Kb)


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

тогда TimSha, верно написал
Редизайнер вам в руки

у нас он тоже есть даже с видеоуроком
Добавлено:
Правда, поскольку у Вас первоначальная таблица некорректно составлена - нужно еще допилить разультат редизайнера несколькими формулами - см пример.

Автор - SLAVICK
Дата добавления - 25.11.2016 в 11:19
TimSha Дата: Пятница, 25.11.2016, 11:35 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 454
Репутация: 73 ±
Замечаний: 0% ±

Excel 2013 Pro +
но чесно очень геморойно.

off А вы хотите эту прелесть взвалить на форумчан, да еще и на халяву?! Подумайте о фрилансерах - они в столе заказов обитают... ;)


"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)

Сообщение отредактировал TimSha - Пятница, 25.11.2016, 13:37
 
Ответить
Сообщение
но чесно очень геморойно.

off А вы хотите эту прелесть взвалить на форумчан, да еще и на халяву?! Подумайте о фрилансерах - они в столе заказов обитают... ;)

Автор - TimSha
Дата добавления - 25.11.2016 в 11:35
Wasilich Дата: Пятница, 25.11.2016, 12:00 | Сообщение № 8
Группа: Друзья
Ранг: Ветеран
Сообщений: 855
Репутация: 220 ±
Замечаний: 0% ±

2003
или макросом, ну и если не сложно не откажусь откакого примера.

По такому принципу пойдет?
[vba]
Код
Sub reorg()
   s = 2
  For i = 2 To 4 Step 2
    Cells(s, 9) = Cells(1, i)
    Cells(s, 10) = Cells(1, i + 1)
    For j = 2 To 7
      Cells(s, 11) = Cells(j, 1)
      Cells(s, 12) = Cells(j, i)
      s = s + 1
    Next j
    s = s + 1
  Next i
End Sub
[/vba]
К сообщению приложен файл: ZamoK.xls(46Kb)


Сообщение отредактировал Wasilich - Пятница, 25.11.2016, 12:01
 
Ответить
Сообщение
или макросом, ну и если не сложно не откажусь откакого примера.

По такому принципу пойдет?
[vba]
Код
Sub reorg()
   s = 2
  For i = 2 To 4 Step 2
    Cells(s, 9) = Cells(1, i)
    Cells(s, 10) = Cells(1, i + 1)
    For j = 2 To 7
      Cells(s, 11) = Cells(j, 1)
      Cells(s, 12) = Cells(j, i)
      s = s + 1
    Next j
    s = s + 1
  Next i
End Sub
[/vba]

Автор - Wasilich
Дата добавления - 25.11.2016 в 12:00
ZamoK Дата: Пятница, 25.11.2016, 13:22 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 214
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
SLAVICK, Спасибо v3 просто шедевр! Огромное спасибо данный макрос мне ещё много раз пригодится. Спасибо


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеSLAVICK, Спасибо v3 просто шедевр! Огромное спасибо данный макрос мне ещё много раз пригодится. Спасибо

Автор - ZamoK
Дата добавления - 25.11.2016 в 13:22
ZamoK Дата: Пятница, 25.11.2016, 13:24 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 214
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
TimSha, Прошу прощенья
взвалить на форумчан, да еще и на халяву?! Подумайте о фрисансерах

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


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеTimSha, Прошу прощенья
взвалить на форумчан, да еще и на халяву?! Подумайте о фрисансерах

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

Автор - ZamoK
Дата добавления - 25.11.2016 в 13:24
ZamoK Дата: Пятница, 25.11.2016, 13:28 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 214
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Wasilich, Результат отличный, только строки , где пустые значения надо убрать, но это я уже сам допилю потихоньку ведь повторюсь пятница сегодня и так уже очень сильно мне помогли. Всем огромное СПАСИБО!


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеWasilich, Результат отличный, только строки , где пустые значения надо убрать, но это я уже сам допилю потихоньку ведь повторюсь пятница сегодня и так уже очень сильно мне помогли. Всем огромное СПАСИБО!

Автор - ZamoK
Дата добавления - 25.11.2016 в 13:28
Wasilich Дата: Пятница, 25.11.2016, 13:38 | Сообщение № 12
Группа: Друзья
Ранг: Ветеран
Сообщений: 855
Репутация: 220 ±
Замечаний: 0% ±

2003
где пустые значения надо убрать

[vba]
Код
   For j = 2 To 7
      If Cells(j, i) <> 0 Then
        Cells(s, 11) = Cells(j, 1)
        Cells(s, 12) = Cells(j, i)
      s = s + 1
      End If
    Next j
[/vba]
 
Ответить
Сообщение
где пустые значения надо убрать

[vba]
Код
   For j = 2 To 7
      If Cells(j, i) <> 0 Then
        Cells(s, 11) = Cells(j, 1)
        Cells(s, 12) = Cells(j, i)
      s = s + 1
      End If
    Next j
[/vba]

Автор - Wasilich
Дата добавления - 25.11.2016 в 13:38
ZamoK Дата: Пятница, 25.11.2016, 14:07 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 214
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
сделал уже так [vba]
Код
If Not Cells(j, i) = 0 Then
      Cells(s, 53) = Cells(j, 1)
      Cells(s, 54) = Cells(j, i)
      s = s + 1
    End If
[/vba]Наверно нет разницы,


Я не Гуру, но стремлюсь!
 
Ответить
Сообщениесделал уже так [vba]
Код
If Not Cells(j, i) = 0 Then
      Cells(s, 53) = Cells(j, 1)
      Cells(s, 54) = Cells(j, i)
      s = s + 1
    End If
[/vba]Наверно нет разницы,

Автор - ZamoK
Дата добавления - 25.11.2016 в 14:07
ZamoK Дата: Пятница, 25.11.2016, 14:12 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 214
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
В общем конечно выглядит так, может надо будет кому[vba]
Код
Sub reorg()
   s = 2
  For i = 2 To 1000 Step 2
    Cells(s, 51) = Cells(1, i)
    Cells(s, 52) = Cells(1, i + 1)
    For j = 2 To 1000
    If Not Cells(j, i) = 0 Then
      Cells(s, 53) = Cells(j, 1)
      Cells(s, 54) = Cells(j, i)
      s = s + 1
    End If
    Next j
    s = s + 1
  Next i

End Sub
[/vba]


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеВ общем конечно выглядит так, может надо будет кому[vba]
Код
Sub reorg()
   s = 2
  For i = 2 To 1000 Step 2
    Cells(s, 51) = Cells(1, i)
    Cells(s, 52) = Cells(1, i + 1)
    For j = 2 To 1000
    If Not Cells(j, i) = 0 Then
      Cells(s, 53) = Cells(j, 1)
      Cells(s, 54) = Cells(j, i)
      s = s + 1
    End If
    Next j
    s = s + 1
  Next i

End Sub
[/vba]

Автор - ZamoK
Дата добавления - 25.11.2016 в 14:12
Wasilich Дата: Пятница, 25.11.2016, 19:17 | Сообщение № 15
Группа: Друзья
Ранг: Ветеран
Сообщений: 855
Репутация: 220 ±
Замечаний: 0% ±

2003
Ну 1000 то надо бы заменить на определение к-ва обрабатываемых колонок и строк.
[vba]
Код
Sub reorg()
  s = 2
  For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column Step 2
    Cells(s, 51) = Cells(1, i)
    Cells(s, 52) = Cells(1, i + 1)
    For j = 2 To Range("A" & Rows.Count).End(xlUp).Row
      If Not Cells(j, i) = 0 Then
         Cells(s, 53) = Cells(j, 1)
         Cells(s, 54) = Cells(j, i)
         s = s + 1
      End If
    Next j
    s = s + 1
  Next i
End Sub
[/vba]


Сообщение отредактировал Wasilich - Пятница, 25.11.2016, 23:41
 
Ответить
СообщениеНу 1000 то надо бы заменить на определение к-ва обрабатываемых колонок и строк.
[vba]
Код
Sub reorg()
  s = 2
  For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column Step 2
    Cells(s, 51) = Cells(1, i)
    Cells(s, 52) = Cells(1, i + 1)
    For j = 2 To Range("A" & Rows.Count).End(xlUp).Row
      If Not Cells(j, i) = 0 Then
         Cells(s, 53) = Cells(j, 1)
         Cells(s, 54) = Cells(j, i)
         s = s + 1
      End If
    Next j
    s = s + 1
  Next i
End Sub
[/vba]

Автор - Wasilich
Дата добавления - 25.11.2016 в 19:17
ZamoK Дата: Понедельник, 28.11.2016, 09:19 | Сообщение № 16
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 214
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Wasilich, До полного идеала :D


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеWasilich, До полного идеала :D

Автор - ZamoK
Дата добавления - 28.11.2016 в 09:19
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменить формат таблицы (Макросы/Sub)
Страница 1 из 11
Поиск:

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