Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
Сортировка данных таблицы по листам по признаку в определенном столбце
 
#1
24.12.2019 16:44:27
Добрый день. Имеет место быть таблица инвентаризации на листе "общ"., в нем вручную в столбце J проставлена принадлежность к определенной группе товара. Возможно ли автоматической заполнение листов (каждый лист-это одна группа товара) с переносом данных из столбцов B-I? В примере фрагмент только по двум группам, т.к. полноценный большой файл невозможно здесь разместить.  
 
 
 
#2
24.12.2019 18:01:08
masaran,
На листе Общ сделал шапку в диапазоне B1:I3, которая будет копироваться в каждый созданный лист.
Запустите макрос Sub RaznestiDannye()
 
 
 
#3
25.12.2019 14:13:01
Простите, а можно сделать, чтобы столбец J не переносился?
 
 
 
#4
25.12.2019 14:26:18
masaran,
Цитата
чтобы столбец J не переносился?
Удалите этот столбец, вставив в код строчку
перед строкой с End With
Код
          .Columns(10).Delete
        End With
 
 
 
#5
25.12.2019 14:30:36
В идеале хотелось в существующем файле изменить лист "общ" и чтобы перезаполнились остальные листы, а так получается ..... начинать с нового файла запускать макрос, а потом восстанавливать все формулы. Это наверное не быстрее ручного перенесения списка товаров.  
 
 
 
#6
25.12.2019 14:36:06
На листе "общ" я не видел формул в ячейках,
поэтому в создаваемые листы переносились значения
Код
.Range("B4").PasteSpecial xlPasteValues

Цитата
хотелось в существующем файле изменить лист "общ" и чтобы перезаполнились остальные листы,
Покажите в примере, что вы хотите
Изменено: Kuzmich - 25.12.2019 14:59:19
 
 
 
#7
25.12.2019 16:52:33
Формулы у меня находятся на листах, распределенных по группам. Там ведется расчет по закрытию пересортов. Весь файл сюда не влазит. Может на почту можно отправить?
 
 
 
#8
25.12.2019 16:53:46
Можно сделать так, чтобы листы не создавались, а заполнялись существующие?
 
 
 
#9
25.12.2019 17:01:09
masaran,
Цитата
листы не создавались, а заполнялись существующие
Можно. Покажите в примере или опишите алгоритм переноса данных с листа "Общ".
Т.е. листы у вас уже существуют и вам надо в соответствующие листы перенести
данные с листа "Общ", так?
 
 
 
#10
25.12.2019 17:08:44
 Да. Хочу, чтобы из столбцов B-I листа общ., переносилась инфа в существующие листы в те же столбцы B-I, но соотвественно с распределением по группам.  
 
 
 
#11
25.12.2019 17:22:47
masaran,
Цитата
в существующие листы
Листы, название которых есть в диапазоне J1:J10 листа "Общ", однозначно имеются в книге?
 
 
 
#12
25.12.2019 17:25:04
Да, имеются.  
 
 
 
#13
25.12.2019 18:20:09
masaran,
На всех ли листах в конце таблицы есть строки в столбце В
Итого
Сальдо
Цитата
Хочу, чтобы из столбцов B-I листа общ., переносилась инфа в существующие листы в те же столбцы B-I
А разве на соответств. листах столбец В не заполнен? Может надо переносить данные из столбцов C-I ?
Изменено: Kuzmich - 25.12.2019 22:28:24 (добавил вопросы)
 
 
 
#14
26.12.2019 17:01:58
Цитата
Kuzmich написал:
А разве на соответств. листах столбец В не заполнен? Может надо переносить данные из столбцов C-I ?
Столбец В и прочее ручками все переносилось из общей таблицы на листе "общ". Просто эта общая таблица периодически обновляется, приходится руками все по новой переносить и распределять по листам-товарным группам. Данные по столбцам N и далее очищаются и начинается новый учет.  
 
 
 
#15
26.12.2019 22:37:49
Попробуйте такой макрос при активном листе Общ
Код
Sub RaznestiDannye()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim n As Long
Dim Criterij As String
Dim iName As String
Dim Sht As Worksheet
Dim iSht As Worksheet
Dim Shapka As Range
Application.ScreenUpdating = False
  Set Sht = ThisWorkbook.Worksheets("Общ")
  iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
     'количество уникальных значений
      n = Cells(1, "J").End(xlDown).Row
    For i = 1 To n          'цикл по уникальным значениям
        Criterij = Sht.Cells(i, "J")
        iName = Criterij    'имя очередного листа
     'ставим автофильтр по столбцу J
       Sht.Range("B14:J" & iLastRow).AutoFilter 9, Criterij
         Set iSht = Worksheets(iName)
        With iSht
          iLR = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            If iLR < 4 Then iLR = 4
          .Range("B4:I" & iLR).ClearContents   'очищаем данные
          'копируем видимые строки без шапки в соответств. лист
         Sht.AutoFilter.Range.Offset(1).Columns("A:H").SpecialCells(xlCellTypeVisible).Copy
          .Range("B4").PasteSpecial xlPasteValues
          Application.CutCopyMode = False
          .Activate
          .Range("B4").Select
        End With
          Sht.Activate
          Sht.AutoFilter.Range.AutoFilter
    Next
Application.ScreenUpdating = True
End Sub
 
 
 
#16
27.12.2019 13:12:02
Ошибка какая то вылазит.  
 
 
 
#17
27.12.2019 13:31:16
Видимо нет листа с таким именем или его написание отличается
 
 
 
#18
27.12.2019 14:09:14
Заработало! Только если в новой таблице на листе "общ" меняется количество товаров определенной группы, то слетают итоговые строки. Если количество уменьшается, то остаются в конце пустые (это можно у руками поудалять). Но вот если увеличивается, то итоговые сроки в пределах столбцов B-I просто затираются. Получается итоги, нужно по новой создавать. Это поправить можно?
 
 
 
#19
27.12.2019 17:28:02
masaran,
Цитата
то итоговые сроки в пределах столбцов B-I просто затираются
Итоговые строки, как видно из вашего первого примера, у вас в столбцах F:I - это Итого
и Сальдо в столбцах F:G  Разве их нужно сохранять при получении нового листа Общ?
Цитата
Получается итоги, нужно по новой создавать.
Можно добавить макросом в каждый лист после переноса данных две строки Итого и Сальдо
 
 
 
#20
28.12.2019 10:37:37
Да. Итоговые строки Итого и Сальдо хотелось бы сохранить абсолютно по всем столбцам. В сроке итого сумма значений по вышестоящим заполненным строкам. Ну а в сальдо расчет на основании "Итого".
Цитата
Kuzmich написал:
Можно добавить макросом в каждый лист после переноса данных две строки Итого и Сальдо
Помогите пожалуйста.  
 
 
 
#21
28.12.2019 11:18:35
masaran,
На листе Общ в конце таблицы есть четыре суммы в ячейках столбцов F:I,
которые не совпадают с суммами по этим столбцам,
например по столбцу F в конце таблицы 10340,756, а сумма по этому столбцу 10345,756
Где правда? Эти суммы используются у вас в расчетах?
 
 
 
#22
28.12.2019 16:30:51
Цитата
Kuzmich написал:
Эти суммы используются у вас в расчетах?
Нет. Не используются.
 
 
 
#23
28.12.2019 16:36:49
masaran,
Пробуйте
Код
Sub RaznestiDannye()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim n As Long
Dim Criterij As String
Dim iName As String
Dim Sht As Worksheet
Dim iSht As Worksheet
Dim FilteredRng As Range
Dim nRow As Long
Application.ScreenUpdating = False
  Set Sht = ThisWorkbook.Worksheets("Общ")
  iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
   Rows(iLastRow + 1).Delete  'удаляем строку с суммами в F:I
     'количество значений групп (Шпон, Файн и т.д.)
      n = Cells(1, "J").End(xlDown).Row
    For i = 1 To n          'цикл по значениям
        Criterij = Sht.Cells(i, "J")   'очередная группа
        iName = Criterij    'имя очередного листа
     'ставим автофильтр по столбцу J
       Sht.Range("B14:J" & iLastRow).AutoFilter 9, Criterij
         Set iSht = Worksheets(iName)
        With iSht                      'очередной лист соотв.группы
          iLR = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            If iLR < 4 Then iLR = 4
          .Range("B4:I" & iLR).Clear   'очищаем данные на соотв.листе
          'копируем видимые строки без шапки в соответств. лист
         Sht.AutoFilter.Range.Offset(1).Columns("A:H").SpecialCells(xlCellTypeVisible).Copy
          .Range("B4").PasteSpecial xlPasteValues
          Application.CutCopyMode = False
          .Activate
          .Range("B4").Select
          iLR = Cells(Rows.Count, "B").End(xlUp).Row
            If iLR < 4 Then iLR = 4
          Range("B4:I" & iLR).Borders.Weight = xlThin    'границы таблицы
          Cells(iLR + 1, "B") = "Итого"                  'вставляем Итого, Сальдо и считаем
          Cells(iLR + 2, "B") = "Сальдо"                 'соответств. суммы
          Cells(iLR + 1, "F") = Application.Sum(Range(Cells(4, "F"), Cells(iLR, "F")))
          Cells(iLR + 1, "G") = Application.Sum(Range(Cells(4, "G"), Cells(iLR, "G")))
          Cells(iLR + 1, "H") = Application.Sum(Range(Cells(4, "H"), Cells(iLR, "H")))
          Cells(iLR + 1, "I") = Application.Sum(Range(Cells(4, "I"), Cells(iLR, "I")))
          Cells(iLR + 2, "F") = Cells(iLR + 1, "F") - Cells(iLR + 1, "H")
          Cells(iLR + 2, "G") = Cells(iLR + 1, "G") - Cells(iLR + 1, "I")
        End With
          Sht.Activate                          'активируем лист Общ
          Sht.AutoFilter.Range.AutoFilter       'возвращаем все значения автофильтра
    Next
Application.ScreenUpdating = True
End Sub

И не исчезайте на сутки, если хотите получить решение
 
 
 
#24
28.12.2019 16:45:48
Результат есть только в столбцах F-I, а по факту итоги в каждых четырех стобцах,    F-I первоначальные значения, J-M текущие, N-Q и далее недельные. Форматирование итоговой строки сохранить нельзя?
 
 
 
#25
28.12.2019 16:56:14
masaran,
Макрос очищает область данных на каждом листе
Код
.Range("B4:I" & iLR).Clear   'очищаем данные на соотв.листе

затем копирует туда данные с листа Общ по соответствующей группе
и подсчитывает сумму по соответствующему столбцу, например по F
Код
Cells(iLR + 1, "F") = Application.Sum(Range(Cells(4, "F"), Cells(iLR, "F")))

Столбцы J-M и N-Q макрос не затрагивает
Цитата
Форматирование итоговой строки сохранить нельзя?
Вы имеете ввиду формат типа 10 345,756
 
 
 
#26
28.12.2019 22:27:21
Я имею ввиду границы, заливку.  
 
 
 
#27
28.12.2019 22:37:26
Цитата
заливку.
Добавьте в макрос две строки перед End With
Код
         Range(Cells(iLR + 1, "F"), Cells(iLR + 2, "I")).NumberFormat = "#,##0.000"
          Range(Cells(iLR + 1, "B"), Cells(iLR + 2, "I")).Interior.ColorIndex = 15
        End With

Это вы имели в виду?
Границы, добавьте +2 в строку          
Код
 Range("B4:I" & iLR + 2).Borders.Weight = xlThin  'границы таблицы
Изменено: Kuzmich - 28.12.2019 22:45:42
 
 
 
#28
29.12.2019 16:12:05
Спасибо. В пределах В-I все работает.
Цитата
Kuzmich написал:
Столбцы J-M и N-Q макрос не затрагивает
А чтобы затрагивал строку по всем столбцам можно?  
Изменено: masaran - 29.12.2019 16:12:47
 
 
 
#29
29.12.2019 16:41:24
Цитата
А чтобы затрагивал строку по всем столбцам можно?
Конечно можно, но что должен делать макрос в этих столбцах?
 
 
 
#30
29.12.2019 16:53:42
а почему бы не обьявить конкурс на "Лучшее описание задачи", стоящей перед автором темы?
работы на конкурс можно присыль прямо сюда в тему, автор выберет наиболее точное и уже по нему можно будет написать макрос для решения этой задачи
а то 30 сообщений в теме, а результата все еще нет...

и понятно, что все это - только после согласия Kuzmichа
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
Страницы: 1 2 След.
Наверх