Страницы: 1
RSS
Как трансформировать данные в плоскую таблицу?
 
Добрый день всем!
Подскажите вариант обработки таблицы из одного варианта в другой.
Необходимо чтобы все команды ОП, СНЭК ВИП выстраивались в колонку F. Данный для каждой команды берутся из колонки сумма корректировок.
Команды в каждом файле меняются. (Могут в одном файле например быть только ВИП и ОП.  
 
Вариант макросом.
Код
Sub Flat()
    Dim x As Integer
    Dim arA As Variant
    Dim arK As Variant
    Dim y As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    
    Set sh1 = ActiveSheet
    With sh1
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        arA = .Range(.Cells(3, 1), .Cells(y, 1))
    End With
    
    Set sh2 = Worksheets.Add
    y = 2
    For x = [I1].Column To [L1].Column Step 3
        sh2.Cells(y, [F1].Column).Resize(UBound(arA, 1)) = sh1.Cells(1, x).Value
        sh2.Cells(y, [C1].Column).Resize(UBound(arA, 1)) = arA
        arK = sh1.Cells(3, x + 2).Resize(UBound(arA, 1))
        sh2.Cells(y, [D1].Column).Resize(UBound(arA, 1)) = arK
        y = y + UBound(arA, 1)
    Next
End Sub
 
Вариант формулами.
Код
C2    =СМЕЩ(Исходник!$A$1;СТРОКА()-2-10*ЦЕЛОЕ((СТРОКА()-2)/10)+2;0)
D2    =СМЕЩ(Исходник!$K$1;СТРОКА()-2-10*ЦЕЛОЕ((СТРОКА()-2)/10)+2;3*ЦЕЛОЕ((СТРОКА()-2)/10))
F2    =СМЕЩ(Исходник!$I$1;0;3*ЦЕЛОЕ((СТРОКА()-2)/10))
Вставить в указанные ячейки и протянуть вниз.
 
Цитата
МатросНаЗебре написал:
Вариант макросом.
Спс Большое, но  имеется ввиду, что надо доставать все группы:
ВИПОПСНЭКСПЦБН
Не только ОП и СНЭК это как пример. Можете дописать макрос.
 
DemonAMT, мне кажется, что у ВИП столбец "Сумма корректировки" должен быть в одном столбце F, а не в трёх - F, G, H. У всех же остальных этот столбец в одном столбце, а не в трёх. И тогда, если удалить пустые столбцы G, H, можно уже писать обработку макросом, т.к. каждая команда будет занимать 3 столбца.
Так же не понятно откуда в итоговой таблице берутся данные для столбцов:
Код НФСП (ОСП)
Код команды
Изменено: New - 01.03.2021 17:56:09
 
так что ли?..
 
Вот для заполнения столбцов C, D, F

Код
Sub Flat()
Dim LastRowSrc As Long, LastRow As Long, LastCol As Long, Team As String, Branch As Range, LineCount As Long, iCol As Long
Dim Sht1 As Worksheet, Sht2 As Worksheet
     
    Set Sht1 = ActiveSheet
    With Sht1
        LastRowSrc = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LineCount = LastRowSrc - 2
        Set Branch = .Range("A3:A" & LastRowSrc)
    End With
     
    Set Sht2 = Worksheets.Add
    For iCol = 4 To LastCol Step 3
        If Sht1.Cells(1, iCol) <> "Итого" Then
            Team = Sht1.Cells(1, iCol)
            LastRow = Sht2.Cells(Sht2.Rows.Count, 3).End(xlUp).Row + 1
            Branch.Copy Sht2.Cells(LastRow, "C") 'филиал
            Sht1.Range(Sht1.Cells(3, iCol + 2), Sht1.Cells(LastRowSrc, iCol + 2)).Copy Sht2.Cells(LastRow, "D") 'сумма корректировки
            Sht2.Cells(LastRow, "F").Resize(LineCount) = Team 'команда
        End If
    Next iCol
    MsgBox "Конец", vbInformation, "Конец"
End Sub
 
New, к сожалению 1 С вытворяет свои чудеса с файлами. Привязываться к количеству столбцов не стоит.

Цитата
ArgentumTiger_7 написал:
так что ли?..
Что то выдает ошибку
Цитата
Expression.Error: Аргументы 5 были переданы функции, которая ожидает значения между 2 и 4.
Сведения:
   Pattern=
   Arguments=List
 
Может тогда вот так

Код
Sub Flat()
Dim LastRowSrc As Long, LastRow As Long, LastCol As Long, Team As String, Branch As Range, LineCount As Long, iCol As Long
Dim Sht1 As Worksheet, Sht2 As Worksheet, Rng As Range, firstAddress As String
     
    Set Sht1 = ActiveSheet
    With Sht1
        LastRowSrc = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LineCount = LastRowSrc - 2
        Set Branch = .Range("A3:A" & LastRowSrc)
    End With
     
    Set Sht2 = Worksheets.Add
 
    With Sht1
        Set Rng = .Rows("1:3").Find("Сумма корректировки", , xlFormulas, xlWhole)
        firstAddress = Rng.Address
        Do
            If Sht1.Cells(1, Rng.Column - 2) <> "Итого" Then
                Team = Sht1.Cells(1, Rng.Column - 2)
                LastRow = Sht2.Cells(Sht2.Rows.Count, 3).End(xlUp).Row + 1
                Branch.Copy Sht2.Cells(LastRow, "C") 'филиал
                Sht1.Range(Sht1.Cells(3, Rng.Column), Sht1.Cells(LastRowSrc, Rng.Column)).Copy Sht2.Cells(LastRow, "D")   'сумма корректировки
                Sht2.Cells(LastRow, "F").Resize(LineCount) = Team 'команда
                Set Rng = .Rows("1:3").FindNext(Rng)
            Else
                Exit Do
            End If
        Loop Until Rng.Address = firstAddress
    End With
    
    MsgBox "Конец", vbInformation, "Конец"
End Sub
 
задачка то прям чтоб запросом ее решить

Код
let
    Источник = Excel.Workbook(File.Contents("C:\Users\User\Desktop\Книга 1.xlsx"), null, true),
    Исходник_Sheet = Источник{[Item="Исходник",Kind="Sheet"]}[Data],
    #"Транспонированная таблица" = Table.Transpose(Исходник_Sheet),
    #"Повышенные заголовки" = Table.PromoteHeaders(#"Транспонированная таблица", [PromoteAllScalars=true]),
    #"Заполнение вниз" = Table.FillDown(#"Повышенные заголовки",{"Филиал"}),
    #"Строки с примененным фильтром" = Table.SelectRows(#"Заполнение вниз", each ([Филиал] <> "Итого") and ([Column2] = "Сумма корректировки")),
    #"Замененное значение" = Table.ReplaceValue(#"Строки с примененным фильтром",null,0,Replacer.ReplaceValue,{"Филиал", "Column2", "Арциз", "Белая церковь", "Бердянск", "Винница", "Днепродзержинск", "Днепропетровск", "Дрогобыч", "Житомир", "Запорожье", "Ивано-Франковск"}),
    #"Другие столбцы с отмененным свертыванием" = Table.UnpivotOtherColumns(#"Замененное значение", {"Филиал", "Column2"}, "Атрибут", "Значение"),
    #"Сведенный столбец" = Table.Pivot(#"Другие столбцы с отмененным свертыванием", List.Distinct(#"Другие столбцы с отмененным свертыванием"[Column2]), "Column2", "Значение"),
    #"Замененное значение1" = Table.ReplaceValue(#"Сведенный столбец",0,null,Replacer.ReplaceValue,{"Сумма корректировки"}),
    #"Строки с примененным фильтром1" = Table.SelectRows(#"Замененное значение1", each ([Филиал] = "ОП" or [Филиал] = "СНЭК")),
    #"Измененный тип" = Table.TransformColumnTypes(#"Строки с примененным фильтром1",{{"Филиал", type text}, {"Сумма корректировки", type number}})
in
    #"Измененный тип"
 
Нужно просто верно ли указать исходник. Я сделал именованный диапазон на основании усеченных данных, а Вы его расширьте  
 
Цитата
DemonAMT написал:
Не только ОП и СНЭК это как пример. Можете дописать макрос.

В этой строке вместо L1 поставьте столбец, в котором находится последний элемент из этой группы ОП, СНЭК и т.д.
Цитата
МатросНаЗебре написал:
For x = [I1].Column To [L1].Column Step 3
 
New, отличный макрос. Спс за помощь.

Цитата
Blood81 написал: задачка то прям чтоб запросом ее решить
Извините, сразу не досмотрел. Отличный результат. Малехо откорректировал и работает Супер. Спасибо за запрос.
Страницы: 1
Наверх