Преобразование файла 1с в базу данных построчно с помощью Power Query

Пользователь

Сообщений: 9 Регистрация: 18.06.2024

05.03.2026 10:47:01

https://disk.yandex.ru/i/fCar5018s4_pBA
Ссылка на файл (не смогла загрузить, так как файл больше 300 кб)
Добрый день! Помогите, пожалуйста, ученице азов Power Query (никогда раньше не преобразовывала данные из отчета 1с)
Нужно из листа получить информацию в "богоподобном виде": ФИО работника, дата, наименование операции (ячейки начинаются "маркировка товаров...", наименование продукции" (полотенце и т.д.), количество
То есть, это нужно привести в вид построчно, а не так, как в файле 1с с выстроенной иерархией строчек, чтобы я дальше могла произвести необходимые расчеты
Не могли бы вы сделать это, скинуть готовый файл и расписать инструкцию, как вы это сделали, чтобы я сама наглядно поняла, как это делать? Так как для меня важно не только сделать конкретный файл, а именно знать, как это делать, чтобы воспользоваться в дальнейшем

Wlad Пользователь Сообщений: 54 Регистрация: 22.12.2012	#2 05.03.2026 12:14:20 Так настройте выгрузку из 1C в нужном Вам виде. В интернете полно инструкций как это сделать!!!

BloomMythix Пользователь Сообщений: 9 Регистрация: 18.06.2024	#3 05.03.2026 13:09:20 Я не тот сотрудник, который занимается настройкой выгрузки файлов из 1с, не смогу. Нужно сегодня посчитать уже

Msi2102 Пользователь Сообщений: 4406 Регистрация: 31.03.2014	#4 05.03.2026 13:32:54 Посмотрите ТУТ, ТУТ, может поможет

ПавелW

Пользователь

Сообщений: 3670 Регистрация: 09.01.2023

excel 2007, 2016, 2021

05.03.2026 16:32:10

Цитата
Нужно сегодня посчитать уже

для вашего "примера" можно полуавтоматически (см файл)

пс: файл безжалостно порезал (пример - должен быть примером)

Прикрепленные файлы

Переклейка_.xlsx (122.6 КБ)

Msi2102

Пользователь

Сообщений: 4406 Регистрация: 31.03.2014

05.03.2026 17:16:53

Цитата
ПавелW написал: можно полуавтоматически (см файл)

, можно автоматически, исправил макрос из первой ссылки, файл большой, удалять лишнее лень

Скрытый текст

Код

Sub Макрос1()
    Dim lev(1 To 5), k As Long, j As Long, m As Byte, arr_r, lr As Long
    Set sd = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A12:E" & lr)
    j = 0
    For n = LBound(arr) To UBound(arr)
        If arr(n, 1) = "" Then arr(n, 1) = "Пусто" 'Exit For
        m = Cells(n + 11, 1).Rows(1).OutlineLevel
        For k = m To UBound(lev)
            lev(k) = ""
        Next
        lev(m) = arr(n, 1)
        lev(5) = arr(n, 5)
        If m = 1 Then If Not sd.Exists(lev(1)) Then Set sd(lev(1)) = CreateObject("Scripting.Dictionary")
        If m = 2 Then If Not sd(lev(1)).Exists(lev(2)) Then Set sd(lev(1))(lev(2)) = CreateObject("Scripting.Dictionary")
        If m = 3 Then If Not sd(lev(1))(lev(2)).Exists(lev(3)) Then Set sd(lev(1))(lev(2))(lev(3)) = CreateObject("Scripting.Dictionary")
        If m = 4 Then
            If Not sd(lev(1))(lev(2))(lev(3)).Exists(lev(4)) Then
                sd(lev(1))(lev(2))(lev(3)).Add lev(4), lev(5)
                j = j + 1
            Else
                sd(lev(1))(lev(2))(lev(3))(lev(4)) = sd(lev(1))(lev(2))(lev(3))(lev(4)) + lev(5)
            End If
        End If
    Next
    ReDim arr_r(1 To j, 1 To 5)
    n = 1
    For Each y1 In sd
        For Each y2 In sd(y1)
            For Each y3 In sd(y1)(y2)
                For Each y4 In sd(y1)(y2)(y3)
                    arr_r(n, 1) = y1
                    arr_r(n, 2) = y2
                    arr_r(n, 3) = y3
                    arr_r(n, 4) = y4
                    arr_r(n, 5) = sd(y1)(y2)(y3)(y4)
                    n = n + 1
                Next
            Next
        Next
    Next
    Range("H11:L" & lr).ClearContents
    Range("H11").Resize(UBound(arr_r), 5) = arr_r
End Sub
Sub Макрос2()
    Dim lev(1 To 5), k As Long, j As Long, m As Byte, arr_r, lr As Long
    Set sd = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A12:E" & lr)
    j = 0
    For n = LBound(arr) To UBound(arr)
        If arr(n, 1) = "" Then arr(n, 1) = "Пусто" 'Exit For
        m = Cells(n + 11, 1).Rows(1).OutlineLevel
        For k = m To UBound(lev)
            lev(k) = ""
        Next
        lev(m) = arr(n, 1)
        If m = 1 Then If Not sd.Exists(lev(1)) Then Set sd(lev(1)) = CreateObject("Scripting.Dictionary")
        If m = 2 Then If Not sd(lev(1)).Exists(lev(2)) Then Set sd(lev(1))(lev(2)) = CreateObject("Scripting.Dictionary")
        If m = 3 Then
            If Not sd(lev(1))(lev(2)).Exists(lev(3)) Then
                sd(lev(1))(lev(2)).Add lev(3), arr(n, 5)
                j = j + 1
            Else
                sd(lev(1))(lev(2))(lev(3)) = sd(lev(1))(lev(2))(lev(3)) + arr(n, 5)
            End If
        End If
    Next
    ReDim arr_r(1 To j, 1 To 4)
    n = 1
    For Each y1 In sd
        For Each y2 In sd(y1)
            For Each y3 In sd(y1)(y2)
                arr_r(n, 1) = y1
                arr_r(n, 2) = y2
                arr_r(n, 3) = y3
                arr_r(n, 4) = sd(y1)(y2)(y3)
                n = n + 1
            Next
        Next
    Next
    Range("N11:Q" & lr).ClearContents
    Range("N11").Resize(UBound(arr_r), 4) = arr_r
End Sub

Читают тему