Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как автоматически сделать 90 одинаковых таблиц из одной?
 
#1
17.01.2022 18:34:37
Добрый день. Есть таблица в которой дана информация по показателям Выручка, Себестоимость, Прибыль и пр. В разрезе 90 магазинов. Подскажите , как на другом листе сделать 90 таблиц (чтобы был указан магазин и подтягивались данные по выручке и пр. и так по 90 магазинам)? Сами формулы пропишу. Интересует именно возможность последующего обновления. Например , если в исходной таблице в след. Месяце будет уже не 90 , а 95 магазинов? И как проще изначально создать лист с 90 магазинами, чтобы не копировать таблицу 90 раз?
 
 
 
#2
17.01.2022 21:29:16
Может так:)
Код
Ctrl+С

For i = 1 to 90
  Ctrl+V
Next i

Приложите файл с исходными данными и точнее сформулируйте задачу.

Изменено: Maksim_A - 17.01.2022 21:32:35
 
 
 
#3
17.01.2022 23:43:41
Цитата
Татьяна написал: как на другом листе сделать 90 таблиц
Вы сможете просматрвать СРАЗУ все 90 таблиц? Не делайте своей голове больно.  Если нужно, в отдельную таблицу у данные по магазину подтянутся за доли секунды (формулами, макросом). Нужен другой магазин - выбрали другой...
 
 
 
#4
18.01.2022 08:27:57
Вот во вложении упрощенный пример. Вкладка "Преобразованные таблицы". Сделана таблица 1. Возможно ли автоматически сделать, чтобы 5 таблиц подтянуть на данный лист, не занимаясь копированием?
 
 
 
#5
18.01.2022 09:57:36
Татьяна, например, так (обратите внимание на зеленый коментарий):
Код
Sub FiveTables()
Dim arr, titlearr, i, Lastrow As Long, k, j
Dim tRange As Range, vRange As Range, titleRange As Range

With ThisWorkbook.Sheets("исх")
    Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    titlearr = .Range(.Cells(1, 1), .Cells(1, 5))
    arr = .Range(.Cells(2, 1), .Cells(Lastrow, 5))
    titlearr = Application.Transpose(Application.Transpose(titlearr))
End With
Set tRange = Worksheets("преобразованные таблицы").Cells(10, 1) ' 10 - номер первой строки для таблиц
    For i = LBound(arr, 1) To UBound(arr, 1)
        
        tRange = titlearr(2): tRange.Offset(0, 3) = titlearr(1)
        tRange.Offset(1, 0) = arr(i, 2): tRange.Offset(1, 3) = arr(i, 1)
        Range(tRange, tRange.Offset(1, 3)).Interior.Color = vbYellow
        Set tRange = tRange.End(xlDown).Offset(2, 0)
        
        tRange = "Показатель": tRange.Offset(0, 1) = "Сумма, руб."
        Range(tRange, tRange.Offset(0, 1)).Borders.LineStyle = xlContinuous
        Set tRange = tRange.Offset(1, 0)
        For k = 3 To UBound(titlearr)
                tRange = titlearr(k): tRange.Offset(0, 1) = arr(i, k)
                Range(tRange, tRange.Offset(0, 1)).Borders.LineStyle = xlContinuous
                Set tRange = tRange.Offset(1, 0)
        Next k
        
        Set tRange = tRange.Offset(2, 0)
    Next i
    
End Sub
 
 
 
#6
18.01.2022 10:00:43
Татьяна,
Цитата
vikttur: в отдельную таблицу у данные по магазину подтянутся за доли секунды (формулами, макросом). Нужен другой магазин - выбрали другой
+++
И не забывайте, что полученные таблицы не сохранят связь с оригиналом (скорее всего) и их (все 90 штук) придётся перевыводить после каждого изменения исходника  ;)
Изменено: Jack Famous - 18.01.2022 10:01:05
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Наверх