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

Вход

Регистрация

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

 

= Мир MS Excel/Анализ значений по двум столбцам - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Анализ значений по двум столбцам (Microsoft Query)
Анализ значений по двум столбцам
elycioo Дата: Пятница, 21.04.2023, 16:10 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 40% ±

Добрый день. Возможно, кто-то знает как решить следующую задачу.
Есть артикулы с предполагаемым цветом (Лист 1) и артикулы с цветом, который изменить нельзя (Лист 2).
Необходимо сделать так, чтобы значения, которые находятся на Лист 1 в поле цвет, были уникальными и не совпадали со значениями в поле цвет на Лист 2 в пределах одного Группировочного кода.
Чтобы сделать значение уникальным, необходимо к значению прибавить 1, т.е. должно получится: черный 1, черный 2, черный 3.
Стоит обратить внимание, что значения на Лист 1 могут в рамках одного Группировочного кода иметь 2 и более артикулов с одинаковым значением в поле цвет. каждое значение должно быть уникальным.
Также стоит обратить внимание, что значения на лист 2 могут также иметь такие значения: черный 1, черный 2, черный 3 и т.д..
Необходимо сделать так, чтобы значению с первого листа прибавилась единица, если не нашлось свободного значения.
К сообщению приложен файл: sostavlenie_cveta.xlsx (312.2 Kb)
 
Ответить
СообщениеДобрый день. Возможно, кто-то знает как решить следующую задачу.
Есть артикулы с предполагаемым цветом (Лист 1) и артикулы с цветом, который изменить нельзя (Лист 2).
Необходимо сделать так, чтобы значения, которые находятся на Лист 1 в поле цвет, были уникальными и не совпадали со значениями в поле цвет на Лист 2 в пределах одного Группировочного кода.
Чтобы сделать значение уникальным, необходимо к значению прибавить 1, т.е. должно получится: черный 1, черный 2, черный 3.
Стоит обратить внимание, что значения на Лист 1 могут в рамках одного Группировочного кода иметь 2 и более артикулов с одинаковым значением в поле цвет. каждое значение должно быть уникальным.
Также стоит обратить внимание, что значения на лист 2 могут также иметь такие значения: черный 1, черный 2, черный 3 и т.д..
Необходимо сделать так, чтобы значению с первого листа прибавилась единица, если не нашлось свободного значения.

Автор - elycioo
Дата добавления - 21.04.2023 в 16:10
msi2102 Дата: Пятница, 21.04.2023, 16:49 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Я понял так, что на артикулы внимания не обращаем от слова совсем?
 
Ответить
СообщениеЯ понял так, что на артикулы внимания не обращаем от слова совсем?

Автор - msi2102
Дата добавления - 21.04.2023 в 16:49
msi2102 Дата: Пятница, 21.04.2023, 18:18 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Попробуйте таким макросом, если правильно понял
[vba]
Код
Sub Макрос1()
Dim arr1, arr2, x, y, k, n As Long, m As Long
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    Set re = CreateObject("VBScript.RegExp")
        re.Pattern = "\d+$"
    arr1 = Sheets("Лист 1").Range("A2:C" & Sheets("Лист 1").Cells(Rows.Count, 1).End(xlUp).Row).Value
    arr2 = Sheets("Лист 2").Range("A2:C" & Sheets("Лист 2").Cells(Rows.Count, 1).End(xlUp).Row).Value
    For n = 1 To UBound(arr1)
        arr1(n, 3) = LCase(RTrim(re.Replace(Trim(arr1(n, 3)), "")))
        If Not dic1.exists(arr1(n, 1)) Then Set dic1(arr1(n, 1)) = CreateObject("Scripting.dictionary")
        If Not dic1(arr1(n, 1)).exists(arr1(n, 3)) Then Set dic1(arr1(n, 1))(arr1(n, 3)) = CreateObject("Scripting.dictionary")
        dic1(arr1(n, 1))(arr1(n, 3)).Add dic1(arr1(n, 1))(arr1(n, 3)).Count + 1, arr1(n, 2)
    Next
    For n = 1 To UBound(arr2)
        arr2(n, 3) = LCase(RTrim(re.Replace(Trim(arr2(n, 3)), "")))
        If Not dic2.exists(arr2(n, 1)) Then Set dic2(arr2(n, 1)) = CreateObject("Scripting.dictionary")
        If Not dic2(arr2(n, 1)).exists(arr2(n, 3)) Then Set dic2(arr2(n, 1))(arr2(n, 3)) = CreateObject("Scripting.dictionary")
        m = 0
        If dic1.exists(arr2(n, 1)) Then If dic1(arr2(n, 1)).exists(arr2(n, 3)) Then m = dic1(arr2(n, 1))(arr2(n, 3)).Count
        dic2(arr2(n, 1))(arr2(n, 3)).Add m + dic2(arr2(n, 1))(arr2(n, 3)).Count + 1, arr2(n, 2)
    Next
    n = 1
    For Each y In dic1
        For Each x In dic1(y)
            For Each k In dic1(y)(x)
                arr1(n, 1) = y
                arr1(n, 2) = dic1(y)(x).Item(k)
                arr1(n, 3) = x & " " & k
                n = n + 1
            Next
        Next
    Next
    n = 1
    For Each y In dic2
        For Each x In dic2(y)
            For Each k In dic2(y)(x)
                arr2(n, 1) = y
                arr2(n, 2) = dic2(y)(x).Item(k)
                arr2(n, 3) = x & " " & k
                n = n + 1
            Next
        Next
    Next
    Sheets("Лист 1").Range("A2").Resize(UBound(arr1), 3) = arr1
    Sheets("Лист 2").Range("A2").Resize(UBound(arr2), 3) = arr2
End Sub
[/vba]
Если стоит стоит старая нумерация, то она удаляется и нумеруется заново
Была ошибка, исправил, файл перезалил
К сообщению приложен файл: sostavlenie_cveta_2.xlsm (324.0 Kb)


Сообщение отредактировал msi2102 - Суббота, 22.04.2023, 11:39
 
Ответить
СообщениеПопробуйте таким макросом, если правильно понял
[vba]
Код
Sub Макрос1()
Dim arr1, arr2, x, y, k, n As Long, m As Long
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    Set re = CreateObject("VBScript.RegExp")
        re.Pattern = "\d+$"
    arr1 = Sheets("Лист 1").Range("A2:C" & Sheets("Лист 1").Cells(Rows.Count, 1).End(xlUp).Row).Value
    arr2 = Sheets("Лист 2").Range("A2:C" & Sheets("Лист 2").Cells(Rows.Count, 1).End(xlUp).Row).Value
    For n = 1 To UBound(arr1)
        arr1(n, 3) = LCase(RTrim(re.Replace(Trim(arr1(n, 3)), "")))
        If Not dic1.exists(arr1(n, 1)) Then Set dic1(arr1(n, 1)) = CreateObject("Scripting.dictionary")
        If Not dic1(arr1(n, 1)).exists(arr1(n, 3)) Then Set dic1(arr1(n, 1))(arr1(n, 3)) = CreateObject("Scripting.dictionary")
        dic1(arr1(n, 1))(arr1(n, 3)).Add dic1(arr1(n, 1))(arr1(n, 3)).Count + 1, arr1(n, 2)
    Next
    For n = 1 To UBound(arr2)
        arr2(n, 3) = LCase(RTrim(re.Replace(Trim(arr2(n, 3)), "")))
        If Not dic2.exists(arr2(n, 1)) Then Set dic2(arr2(n, 1)) = CreateObject("Scripting.dictionary")
        If Not dic2(arr2(n, 1)).exists(arr2(n, 3)) Then Set dic2(arr2(n, 1))(arr2(n, 3)) = CreateObject("Scripting.dictionary")
        m = 0
        If dic1.exists(arr2(n, 1)) Then If dic1(arr2(n, 1)).exists(arr2(n, 3)) Then m = dic1(arr2(n, 1))(arr2(n, 3)).Count
        dic2(arr2(n, 1))(arr2(n, 3)).Add m + dic2(arr2(n, 1))(arr2(n, 3)).Count + 1, arr2(n, 2)
    Next
    n = 1
    For Each y In dic1
        For Each x In dic1(y)
            For Each k In dic1(y)(x)
                arr1(n, 1) = y
                arr1(n, 2) = dic1(y)(x).Item(k)
                arr1(n, 3) = x & " " & k
                n = n + 1
            Next
        Next
    Next
    n = 1
    For Each y In dic2
        For Each x In dic2(y)
            For Each k In dic2(y)(x)
                arr2(n, 1) = y
                arr2(n, 2) = dic2(y)(x).Item(k)
                arr2(n, 3) = x & " " & k
                n = n + 1
            Next
        Next
    Next
    Sheets("Лист 1").Range("A2").Resize(UBound(arr1), 3) = arr1
    Sheets("Лист 2").Range("A2").Resize(UBound(arr2), 3) = arr2
End Sub
[/vba]
Если стоит стоит старая нумерация, то она удаляется и нумеруется заново
Была ошибка, исправил, файл перезалил

Автор - msi2102
Дата добавления - 21.04.2023 в 18:18
elycioo Дата: Понедельник, 24.04.2023, 13:24 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 40% ±

msi2102, А возможно ли это сделать с помощью PQ?
 
Ответить
Сообщениеmsi2102, А возможно ли это сделать с помощью PQ?

Автор - elycioo
Дата добавления - 24.04.2023 в 13:24
msi2102 Дата: Понедельник, 24.04.2023, 15:05 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Можно, но у меня сейчас нет PQ, может кто-нибудь ещё поможет
 
Ответить
СообщениеМожно, но у меня сейчас нет PQ, может кто-нибудь ещё поможет

Автор - msi2102
Дата добавления - 24.04.2023 в 15:05
elycioo Дата: Суббота, 29.04.2023, 15:07 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 40% ±

msi2102, Тут еще ошибка в том, что данный макрос меняет значения на листе 2, а должен не менять их, а учитывать при присваивании значений для цвета на листе 1.
 
Ответить
Сообщениеmsi2102, Тут еще ошибка в том, что данный макрос меняет значения на листе 2, а должен не менять их, а учитывать при присваивании значений для цвета на листе 1.

Автор - elycioo
Дата добавления - 29.04.2023 в 15:07
msi2102 Дата: Суббота, 29.04.2023, 23:32 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
что данный макрос меняет значения на листе 2
Немного об алгоритме:
- Вначале собираем пронумерованные цвета с листа 2, дубли нумеруются прибавляя 1 к существующему номеру;
- Собираем оставшиеся цвета без нумерации и нумеруем их начиная с 1 или если 1 есть то со следующего номера;
- На листе 1 удаляется вся предыдущая нумерация и присваивается нумерация с 1 или со следующего учитывая оба списка.
Немного пояснений:
Если номер на листе 2 повторяется дважды (это наглядно на примере: Группировочный код - A056218825, цвет Синий 2) то к дублям прибавляется следующий номер (на выше указанном примере результат: Синий 2, Синий 3 и т.д.) вне зависимости от наличия предыдущих номеров, поэтому может сложиться ситуация, если больше не будет строки с таким группировочным кодом и цветом (например группировочный код a11111111111111, цвет Синий 2) то начало будет не с 1, а с 2. Если есть ещё дублирующие строки с одинаковым кодом и цветом, но без номера, то нумерация этих значений начинается с 1, поэтому возможен разрыв нумерации (например группировочный код а22222222222222, два цвета Синий с номером 7 и один без номера и один на листе 2).
[vba]
Код
Sub Макрос2()
    Dim arr1, arr2, x, y, k, n As Long, nn As Long, m As Long
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    Set re = CreateObject("VBScript.RegExp")
        re.Pattern = "\d+$"
    arr2 = Sheets("Лист 1").Range("A2:C" & Sheets("Лист 1").Cells(Rows.Count, 1).End(xlUp).Row).Value
    arr1 = Sheets("Лист 2").Range("A2:C" & Sheets("Лист 2").Cells(Rows.Count, 1).End(xlUp).Row).Value
    For n = 1 To UBound(arr1)
        col = LCase(RTrim(re.Replace(Trim(arr1(n, 3)), "")))
        If re.Test(arr1(n, 3)) Then
            m = CLng(re.Execute(arr1(n, 3)).Item(0))
            If Not dic1.exists(arr1(n, 1)) Then Set dic1(arr1(n, 1)) = CreateObject("Scripting.dictionary")
            If Not dic1(arr1(n, 1)).exists(col) Then Set dic1(arr1(n, 1))(col) = CreateObject("Scripting.dictionary")
            If Not dic1(arr1(n, 1))(col).exists(m) Then
                dic1(arr1(n, 1))(col).Add m, arr1(n, 2)
            Else
                Do While dic1(arr1(n, 1))(col).exists(m)
                    m = m + 1
                Loop
                dic1(arr1(n, 1))(col).Add m, arr1(n, 2)
            End If
            arr1(n, 1) = ""
        End If
    Next
    For n = 1 To UBound(arr1)
        If arr1(n, 1) <> "" Then
            arr1(n, 3) = LCase(RTrim(re.Replace(Trim(arr1(n, 3)), "")))
            If Not dic1.exists(arr1(n, 1)) Then Set dic1(arr1(n, 1)) = CreateObject("Scripting.dictionary")
            If Not dic1(arr1(n, 1)).exists(arr1(n, 3)) Then Set dic1(arr1(n, 1))(arr1(n, 3)) = CreateObject("Scripting.dictionary")
            For m = 1 To dic1(arr1(n, 1))(arr1(n, 3)).Count + 1
                If Not dic1(arr1(n, 1))(arr1(n, 3)).exists(m) Then dic1(arr1(n, 1))(arr1(n, 3)).Add m, arr1(n, 2): Exit For
            Next
        End If
    Next
    For n = 1 To UBound(arr2)
        arr2(n, 3) = LCase(RTrim(re.Replace(Trim(arr2(n, 3)), "")))
        If Not dic2.exists(arr2(n, 1)) Then Set dic2(arr2(n, 1)) = CreateObject("Scripting.dictionary")
        If Not dic2(arr2(n, 1)).exists(arr2(n, 3)) Then Set dic2(arr2(n, 1))(arr2(n, 3)) = CreateObject("Scripting.dictionary")
        nn = 0
        If dic1.exists(arr2(n, 1)) Then If dic1(arr2(n, 1)).exists(arr2(n, 3)) Then nn = dic1(arr2(n, 1))(arr2(n, 3)).Count
        For m = 1 To nn + 1 + dic2(arr2(n, 1))(arr2(n, 3)).Count + 1
            If nn = 0 Then
                If Not dic2(arr2(n, 1))(arr2(n, 3)).exists(m) Then dic2(arr2(n, 1))(arr2(n, 3)).Add m, arr2(n, 2): Exit For
            Else
                If Not dic2(arr2(n, 1))(arr2(n, 3)).exists(m) And Not dic1(arr2(n, 1))(arr2(n, 3)).exists(m) Then dic2(arr2(n, 1))(arr2(n, 3)).Add m, arr2(n, 2): Exit For
            End If
        Next
    Next
    n = 1
    For Each y In dic1
        For Each x In dic1(y)
            For Each k In dic1(y)(x)
                arr1(n, 1) = y
                arr1(n, 2) = dic1(y)(x).Item(k)
                arr1(n, 3) = x & " " & k
                n = n + 1
            Next
        Next
    Next
    n = 1
    For Each y In dic2
        For Each x In dic2(y)
            For Each k In dic2(y)(x)
                arr2(n, 1) = y
                arr2(n, 2) = dic2(y)(x).Item(k)
                arr2(n, 3) = x & " " & k
                n = n + 1
            Next
        Next
    Next
    dic1.RemoveAll
    dic2.RemoveAll
    Sheets("Лист 1").Range("E2").Resize(UBound(arr2), 3) = arr2
    Sheets("Лист 2").Range("E2").Resize(UBound(arr1), 3) = arr1
End Sub
[/vba]
Для лучшего понимания таблицу с результатом вставил рядом
К сообщению приложен файл: sostavlenie_cveta_4.xlsm (331.1 Kb)


Сообщение отредактировал msi2102 - Суббота, 29.04.2023, 23:43
 
Ответить
Сообщение
что данный макрос меняет значения на листе 2
Немного об алгоритме:
- Вначале собираем пронумерованные цвета с листа 2, дубли нумеруются прибавляя 1 к существующему номеру;
- Собираем оставшиеся цвета без нумерации и нумеруем их начиная с 1 или если 1 есть то со следующего номера;
- На листе 1 удаляется вся предыдущая нумерация и присваивается нумерация с 1 или со следующего учитывая оба списка.
Немного пояснений:
Если номер на листе 2 повторяется дважды (это наглядно на примере: Группировочный код - A056218825, цвет Синий 2) то к дублям прибавляется следующий номер (на выше указанном примере результат: Синий 2, Синий 3 и т.д.) вне зависимости от наличия предыдущих номеров, поэтому может сложиться ситуация, если больше не будет строки с таким группировочным кодом и цветом (например группировочный код a11111111111111, цвет Синий 2) то начало будет не с 1, а с 2. Если есть ещё дублирующие строки с одинаковым кодом и цветом, но без номера, то нумерация этих значений начинается с 1, поэтому возможен разрыв нумерации (например группировочный код а22222222222222, два цвета Синий с номером 7 и один без номера и один на листе 2).
[vba]
Код
Sub Макрос2()
    Dim arr1, arr2, x, y, k, n As Long, nn As Long, m As Long
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    Set re = CreateObject("VBScript.RegExp")
        re.Pattern = "\d+$"
    arr2 = Sheets("Лист 1").Range("A2:C" & Sheets("Лист 1").Cells(Rows.Count, 1).End(xlUp).Row).Value
    arr1 = Sheets("Лист 2").Range("A2:C" & Sheets("Лист 2").Cells(Rows.Count, 1).End(xlUp).Row).Value
    For n = 1 To UBound(arr1)
        col = LCase(RTrim(re.Replace(Trim(arr1(n, 3)), "")))
        If re.Test(arr1(n, 3)) Then
            m = CLng(re.Execute(arr1(n, 3)).Item(0))
            If Not dic1.exists(arr1(n, 1)) Then Set dic1(arr1(n, 1)) = CreateObject("Scripting.dictionary")
            If Not dic1(arr1(n, 1)).exists(col) Then Set dic1(arr1(n, 1))(col) = CreateObject("Scripting.dictionary")
            If Not dic1(arr1(n, 1))(col).exists(m) Then
                dic1(arr1(n, 1))(col).Add m, arr1(n, 2)
            Else
                Do While dic1(arr1(n, 1))(col).exists(m)
                    m = m + 1
                Loop
                dic1(arr1(n, 1))(col).Add m, arr1(n, 2)
            End If
            arr1(n, 1) = ""
        End If
    Next
    For n = 1 To UBound(arr1)
        If arr1(n, 1) <> "" Then
            arr1(n, 3) = LCase(RTrim(re.Replace(Trim(arr1(n, 3)), "")))
            If Not dic1.exists(arr1(n, 1)) Then Set dic1(arr1(n, 1)) = CreateObject("Scripting.dictionary")
            If Not dic1(arr1(n, 1)).exists(arr1(n, 3)) Then Set dic1(arr1(n, 1))(arr1(n, 3)) = CreateObject("Scripting.dictionary")
            For m = 1 To dic1(arr1(n, 1))(arr1(n, 3)).Count + 1
                If Not dic1(arr1(n, 1))(arr1(n, 3)).exists(m) Then dic1(arr1(n, 1))(arr1(n, 3)).Add m, arr1(n, 2): Exit For
            Next
        End If
    Next
    For n = 1 To UBound(arr2)
        arr2(n, 3) = LCase(RTrim(re.Replace(Trim(arr2(n, 3)), "")))
        If Not dic2.exists(arr2(n, 1)) Then Set dic2(arr2(n, 1)) = CreateObject("Scripting.dictionary")
        If Not dic2(arr2(n, 1)).exists(arr2(n, 3)) Then Set dic2(arr2(n, 1))(arr2(n, 3)) = CreateObject("Scripting.dictionary")
        nn = 0
        If dic1.exists(arr2(n, 1)) Then If dic1(arr2(n, 1)).exists(arr2(n, 3)) Then nn = dic1(arr2(n, 1))(arr2(n, 3)).Count
        For m = 1 To nn + 1 + dic2(arr2(n, 1))(arr2(n, 3)).Count + 1
            If nn = 0 Then
                If Not dic2(arr2(n, 1))(arr2(n, 3)).exists(m) Then dic2(arr2(n, 1))(arr2(n, 3)).Add m, arr2(n, 2): Exit For
            Else
                If Not dic2(arr2(n, 1))(arr2(n, 3)).exists(m) And Not dic1(arr2(n, 1))(arr2(n, 3)).exists(m) Then dic2(arr2(n, 1))(arr2(n, 3)).Add m, arr2(n, 2): Exit For
            End If
        Next
    Next
    n = 1
    For Each y In dic1
        For Each x In dic1(y)
            For Each k In dic1(y)(x)
                arr1(n, 1) = y
                arr1(n, 2) = dic1(y)(x).Item(k)
                arr1(n, 3) = x & " " & k
                n = n + 1
            Next
        Next
    Next
    n = 1
    For Each y In dic2
        For Each x In dic2(y)
            For Each k In dic2(y)(x)
                arr2(n, 1) = y
                arr2(n, 2) = dic2(y)(x).Item(k)
                arr2(n, 3) = x & " " & k
                n = n + 1
            Next
        Next
    Next
    dic1.RemoveAll
    dic2.RemoveAll
    Sheets("Лист 1").Range("E2").Resize(UBound(arr2), 3) = arr2
    Sheets("Лист 2").Range("E2").Resize(UBound(arr1), 3) = arr1
End Sub
[/vba]
Для лучшего понимания таблицу с результатом вставил рядом

Автор - msi2102
Дата добавления - 29.04.2023 в 23:32
AlienSphinx Дата: Воскресенье, 30.04.2023, 09:03 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 6 ±
Замечаний: 0% ±

вариант PQ. Регистр игнориуется, а то у вас встречаются "белый" и "Белый".
[vba]
Код
let
    // группируем 1-й список по коду
    SL1 = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    ct1 = Table.TransformColumnTypes(SL1,{{"Группировочный код", type text}}),
    g1 = Table.Group(ct1, {"Группировочный код"}, {{"L1", each _}}),
    // группируем 2-й список по коду и формируем record
    SL2 = Excel.CurrentWorkbook(){[Name="Table2"]}[Content],
    ct2 = Table.TransformColumnTypes(SL2,{{"Группировочный код", type text}}),
    g2 = Table.Group(ct2, {"Группировочный код"}, {{"L2", each _}}),
    r2 = Record.FromList(g2[L2], g2[Группировочный код] ),
    // list_12 - добавляем цвета из 2-й таблицы для сравнения
    null_r = [Цвет = {""}],
    list_12 = Table.Buffer(Table.AddColumn(g1, "L2", each Record.FieldOrDefault(r2, [Группировочный код], null_r)[Цвет])),
    // функция перебора и изменения цветов таблиц из списка 1
    txform_colors = (tbl_01 as table, lst_02 as list) =>
        let
            lst_01 = tbl_01[Цвет],
            max_01 = List.Count(lst_01),
            txf =
                List.Generate(
                    () => [i = -1, clr = {}, test_colors = lst_02],
                    (x) => x[i] < max_01,
                    (x) =>
                        let
                            a = x[i] + 1,
                            b = find_color(lst_01{a}, x[test_colors], 0)
                        in [i = a, clr = x[clr] & {b{0}}, test_colors = b{1}],
                    (x) => x[clr]
                ),
            out = Table.FromColumns(List.RemoveLastN(Table.ToColumns(tbl_01), 1) & {List.Last(txf)}, Table.ColumnNames(tbl_01))
        in out,
    // функция изменения цвета при сравнении со списком
    find_color = (color as text, c_list as list, n as any) as list =>
        let
            new_color = if n = 0 then color else color & " " & Text.From(n)
        in if List.Contains(c_list, new_color, Comparer.OrdinalIgnoreCase) then @find_color(color, c_list, n + 1) else {new_color, c_list & {new_color}},
    // запускаем txform_colors и кладем рез-т в новую колонку
    L3 = Table.AddColumn(list_12, "L3", (x) => txform_colors(x[L1], x[L2])),
    // выводим только новую колонку, собирая все таблицы воедино
    z = Table.Combine(L3[L3])
in
    z
[/vba]
К сообщению приложен файл: 9054326.xlsx (330.9 Kb)
 
Ответить
Сообщениевариант PQ. Регистр игнориуется, а то у вас встречаются "белый" и "Белый".
[vba]
Код
let
    // группируем 1-й список по коду
    SL1 = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    ct1 = Table.TransformColumnTypes(SL1,{{"Группировочный код", type text}}),
    g1 = Table.Group(ct1, {"Группировочный код"}, {{"L1", each _}}),
    // группируем 2-й список по коду и формируем record
    SL2 = Excel.CurrentWorkbook(){[Name="Table2"]}[Content],
    ct2 = Table.TransformColumnTypes(SL2,{{"Группировочный код", type text}}),
    g2 = Table.Group(ct2, {"Группировочный код"}, {{"L2", each _}}),
    r2 = Record.FromList(g2[L2], g2[Группировочный код] ),
    // list_12 - добавляем цвета из 2-й таблицы для сравнения
    null_r = [Цвет = {""}],
    list_12 = Table.Buffer(Table.AddColumn(g1, "L2", each Record.FieldOrDefault(r2, [Группировочный код], null_r)[Цвет])),
    // функция перебора и изменения цветов таблиц из списка 1
    txform_colors = (tbl_01 as table, lst_02 as list) =>
        let
            lst_01 = tbl_01[Цвет],
            max_01 = List.Count(lst_01),
            txf =
                List.Generate(
                    () => [i = -1, clr = {}, test_colors = lst_02],
                    (x) => x[i] < max_01,
                    (x) =>
                        let
                            a = x[i] + 1,
                            b = find_color(lst_01{a}, x[test_colors], 0)
                        in [i = a, clr = x[clr] & {b{0}}, test_colors = b{1}],
                    (x) => x[clr]
                ),
            out = Table.FromColumns(List.RemoveLastN(Table.ToColumns(tbl_01), 1) & {List.Last(txf)}, Table.ColumnNames(tbl_01))
        in out,
    // функция изменения цвета при сравнении со списком
    find_color = (color as text, c_list as list, n as any) as list =>
        let
            new_color = if n = 0 then color else color & " " & Text.From(n)
        in if List.Contains(c_list, new_color, Comparer.OrdinalIgnoreCase) then @find_color(color, c_list, n + 1) else {new_color, c_list & {new_color}},
    // запускаем txform_colors и кладем рез-т в новую колонку
    L3 = Table.AddColumn(list_12, "L3", (x) => txform_colors(x[L1], x[L2])),
    // выводим только новую колонку, собирая все таблицы воедино
    z = Table.Combine(L3[L3])
in
    z
[/vba]

Автор - AlienSphinx
Дата добавления - 30.04.2023 в 09:03
elycioo Дата: Четверг, 04.05.2023, 10:45 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 40% ±

AlienSphinx, На последнем этапе выдает вот такую ошибку.( Это может быть связано с версией ексель?
К сообщению приложен файл: 2429193.jpg (81.4 Kb)
 
Ответить
СообщениеAlienSphinx, На последнем этапе выдает вот такую ошибку.( Это может быть связано с версией ексель?

Автор - elycioo
Дата добавления - 04.05.2023 в 10:45
AlienSphinx Дата: Четверг, 04.05.2023, 12:05 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 6 ±
Замечаний: 0% ±

elycioo, возможно, т.к. у меня файл работает без ошибок. Запустите обновление офиса (не версию поменять, а все доступные для вашей версии обновления установить).
 
Ответить
Сообщениеelycioo, возможно, т.к. у меня файл работает без ошибок. Запустите обновление офиса (не версию поменять, а все доступные для вашей версии обновления установить).

Автор - AlienSphinx
Дата добавления - 04.05.2023 в 12:05
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Анализ значений по двум столбцам (Microsoft Query)
  • Страница 1 из 1
  • 1
Поиск:

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