Страницы: 1
RSS
Формирование словаря из словарей по уникальному ключу массива.
 
Добрый день!
Не могу сообразить как работать с многомерным массивом, есть исходная таблица, она обработана через словарь. где номер строки это ключ, значение = двумерный массив.
На выходе надо получить для каждого уникального значения в первом столбце(1,1) (желтым в целевой таблице), массив без дубликатов из строк, в которых первый столбец ключевой.
В целевой таблице, это то, что должно получиться в итоговом массиве для каждой записи в словаре.
Нужно именно в словаре, не в коллекции. Не получается именно создать многомерный массив, и заполнить его корректно.
Плюс обработать записи в массиве, чтобы не было совпадений.
Цель, получить в словаре ключ из первого столбца, и массив включая сам первый столбец, с уникальными для первого столбца записями.
Возможно я не в ту сторону рою, и многомерный массив тут не нужен.
 
Изменено: Mergens - 10.02.2019 03:54:02
 
Mergens, применительно к вашему примеру:
Код
Sub aaa()
Dim arr(), cc(), dd(), a&, b&, c&, d&, DC As New Scripting.Dictionary, kk
With Sheets(1)
  .Columns("J:O").Rows("2:" & .UsedRange.Rows.Count).Clear
  arr = Intersect(.[a2].CurrentRegion, .Rows("2:" & .Cells(.Rows.Count, 2).End(xlUp).Row)).Value
  For a = 1 To UBound(arr)
    If Not DC.Exists(arr(a, 1)) Then
      ReDim dd(1 To 1): dd(1) = a: DC.Add arr(a, 1), dd
    Else
      dd = DC.Item(arr(a, 1)): ReDim Preserve dd(1 To UBound(dd) + 1)
      dd(UBound(dd)) = a: DC.Item(arr(a, 1)) = dd
    End If
  Next
  dd = DC.Items: b = 2: a = 0
  ReDim cc(1 To UBound(arr), 1 To UBound(arr, 2) - 1)
  For Each kk In DC.Keys
    With .Cells(b, 10)
      .NumberFormat = "@": .Value = kk: .Borders.LineStyle = 9
    End With
    For c = 1 To UBound(dd(a))
      For d = 2 To UBound(arr, 2)
        cc(b - 1, d - 1) = arr(dd(a)(c), d)
      Next
      b = b + 1
    Next
    a = a + 1
  Next
  With .Cells(2, 11).Resize(UBound(cc), UBound(cc, 2))
    .NumberFormat = "@": .Borders.LineStyle = 1: .Value = cc
  End With
End With
Set DC = Nothing
End Sub

Возможно чуть позже сделаю не на массивах.
 
Доброе время суток.
Anchoret, не уловил. Результат никак не сбивается с тем, что должно быть на выходе у ТС на листе.
Updated
Версия на Power Query.
P. S. Судя по выводу ТС нужно для каждого уникального значения столбца один, оставить в каждом столбце от 2 до 6 только уникальные значения.
Изменено: Андрей VG - 10.02.2019 10:29:18
 
Mergens,так вся строка является критерием уникальности помимо первой ячейки строки, или какие-то отдельные элементы этой строки? Если уники искать по всем столбцам, то это жесть)
------
Действительно по всем столбцам...
Изменено: Anchoret - 10.02.2019 12:06:31
 
Цитата
Anchoret написал:
Если уники искать по всем столбцам, то это жесть)
А почему? Вроде ничего такого страшного...
 
Цитата
Anchoret написал: вся строка является критерием уникальности помимо первой ячейки строки, или какие-то отдельные элементы этой строки?
Добрый день!
Андрей правильно ответил.
Первый столбец уникален и является ключем для словаря ld.Key, в словарь надо положить массив в котором будут лежать только уникальные значения  с первого(он тоже нужен,) по 6 столбец ld.Items.
Таким образом получается, что для каждого уникального значения из столбца 1, собирается массив = сам 1 столбец уникальный(всегда 1 запись), 2 столбец(уникальные записи, для 1го), 3 столбец(уникальные для 1го), 4 столбец(уникальные для 1го) и т.д.

В файле сделал целевую область, это именно то, что должно лежать в массиве на выходе, после прохода всех строчек.
 
Цитата
Anchoret написал:  Mergens , применительно к вашему примеру
Результат должен состоять только из уникальных записей. с 1 го по 6 й столбец,, по сути к Вашему результату, в каждом столбце надо удалить дубликаты.

Цитата
Андрей VG написал:  Anchoret  написал:Если уники искать по всем столбцам, то это жесть)А почему? Вроде ничего такого страшного...
Андрей спасибо, что помогли получить результат.  
Изменено: Mergens - 10.02.2019 16:00:30
 
Андрей VG,  изначально пошел не по тому пути + пропустил часть описания задачи. Но на этом не остановился и стал искоренять все дубли по столбцам по каждому опорному значению в столбце "А". В общем сам себе придумал квест, а потом глянул третий раз на искомый результат в файле-примере и понял что занимался всем этим зря) Не мой день...

Ну и раз написал черт знает что, то вдруг такое глобальное искоренение дублей кому нужно... Вот:
Скрытый текст
Изменено: Anchoret - 10.02.2019 14:35:32
 
Anchoret, бывает... Значит надо сегодня забросить форум и пойти прогуляться по городу :)  Успехов.
 
собрать уникальные значения, которые по определению понятия "уникальный" уникальными не являются
собрать уникальные, которые на самом деле совсем не уникальные
эту задачу решаем?
Изменено: Ігор Гончаренко - 10.02.2019 14:51:16
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ну вроде да, если я правильно Вас понял, удалить все дубли для первого столбца, в последующих столбцах. первый столбец есть ключ, по которому определяется область из которой удалять дубли со 2го по 6ой столбцы.

Anchoret, точно сегодня надо завязывать с форумом))) у вас в результате только первая строка с ключем.
В исходном файле указан тот результат, что должен получиться на выходе.
Изменено: Mergens - 10.02.2019 16:01:11
 
Mergens, спасибо, кэп)
 
Андрей VG Хотел сказать Спасибо. очень помогли.
возникла теперь потребность в том чтобы, получать конкретный словарь в из коллекции словарей по ключу после обработки всего массива.

Например: для ключа 10010394, получить словарь по номеру 3 со всеми значениями из FUniques() и т.д из другой процедуры.

Я расширил процедуру Create, передаю массив и принимаю сформированный словарь
Код
'----------------------------------------------------------------------------------------------------
Public Sub Create(ByVal byArray As Variant, FUItems As Scripting.Dictionary)
    Dim curItem As UniqueItem, iRow As Long, iCol As Long
    Set FUniqueItems = New Scripting.Dictionary
    FColumnCount = UBound(byArray, 2) - 1
    For iRow = 1 To UBound(byArray, 1)
        Set curItem = GetUniqueItem(byArray(iRow, 1))
        For iCol = 2 To UBound(byArray, 2)
            curItem.Append iCol - 1, CStr(byArray(iRow, iCol))
        Next
    Next
    Set FUItems = FUniqueItems
End Sub
похожу циклом по полученному словарю
Код
Sub FUSelect(FUItems as Scripting.Dictionary, ld as Scripting.Dictionary)
Dim sKey
Set ld = new Scripting.Dictionary

  For Each sKey in FUItems.Keys
     Call FUGetDic(FUItems(sKey), 2, ld)  'пытаемся получить внутренний словарь с кодом
         
  Next
End Sub
но никак не могу получить внутренние словари по ключу.
Код
Sub FUGetDic(FUItems as Object, lKey as Integer, FUDic as Scripting.Dictionary)
   
     Set FUDic = FUItems.FUniques(lKey)

End sub
Так и не понял что не так, получаю ошибки.
 
Словарь словарей есть. Теперь массив массивов:
Скрытый текст
Изменено: Anchoret - 11.02.2019 01:14:52
 
Цитата
Anchoret написал: Словарь словарей есть. Теперь массив массивов
А теперь словарь массивов словарей  :D
Скрытый текст

Не так элегантно как у Андрея (Андрей VG, ), но работает
Цитата
Mergens написал: никак не могу получить внутренние словари по ключу
Вот в этом блоке кода происходит именно это - получение массива словарей по главному ключу
Код
For Each mainKey In .Keys
    '-------
Next
Изменено: Sanja - 11.02.2019 08:00:54
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Mergens написал:
Я расширил процедуру Create, передаю массив и принимаю сформированный словарь
Зачем нарушать принципы ООП? В класс UniqueItem добавьте метод
Код
Friend Function GetColumnUniques(ByVal columnId As Long) As Variant
    GetColumnUniques = FUniques(columnId).Keys
End Function

А в класс UniqueCollection
Код
' uniqueKey ключ уникального значения первого столбца, columnId номер ассоциированного тому ключу уникальных значений (начиная с 1, в примере значения от 1 до 5)
Public Function GetColumnUniques(ByVal uniqueKey As String, ByVal columnId As Long) As Variant
    GetColumnUniques = FUniqueItems(uniqueKey).GetColumnUniques(columnId)
End Function

Тогда в методе CreateUniqueArray модуля UniqueTaskModule можно получить массив уникальных значений для данного 10010394
Код
    Dim col3Uniques
    col3Uniques = uCollection.GetColumnUniques("10010394", 3)

Цитата
Sanja написал:
А теперь словарь массивов словарей
Отлично! Спасибо.
 
На всем чем можно  :D . На файле примере работает.
Скрытый текст
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, вышло посимпатичнее моего франкенштейна раз пять перештопанного)
 
Цитата
Anchoret написал:вышло посимпатичнее моего франкенштейна
:D
Я вчера глянул на задание , и подумал, что в выходной я такое делать не стану, иначе мозг взорвется.
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, а я вот не удержался) Если бы не ходил окольными путями, то ничего сложного, но мы не ищем легких путей)
 
Андрей VG Добрый вечер!

Добавил в классы разработку, но получаю ошибку в функции. Ключ переобразовал, т.к. нужны ведущие нули.
Изменено: Mergens - 11.02.2019 21:36:05
 
Public Function GetColumnUniques(ByVal uniqueKey As String, ByVal columnId As Long) As Variant?
Согласие есть продукт при полном непротивлении сторон
 
Ну вроде все корректно, но что то не так. что то в методе класса не так.  
файл приложил
Изменено: Mergens - 11.02.2019 21:54:15
 
Цитата
Mergens написал:
Public Function GetColumnUniques(ByVal uniqueKey As String, ByVal columnId As Long) As Variant?
Не, коллега. Тут всё забавнее.
Если дополнительные методы в классах описаны как выше, то применение col3Uniques = uCollection.GetColumnUniques("10010394", 3) действительно даёт ошибку, если метод GetColumnUniques в классе UniqueItem имеет атрибут доступа Friend. Видимо, когда доступ к этому методу идёт сразу через
Код
FUniqueItems(uniqueKey).GetColumnUniques(columnId)
это трактуется как позднее связывание (объект в словаре просто типа Object, а не UniqueItem) и, соответственно, метод GetColumnUniques в классе UniqueItem считается расположенным в другом пространстве, следовательно недоступен. Если поменять атрибут доступа на Public, то работает.
Если оставить Friend, то нужно переписать метод GetColumnUniques класса UniqueCollection в такой вид
Код
Public Function GetColumnUniques(ByVal uniqueKey As String, ByVal columnId As Long) As Variant
    Dim pItem As UniqueItem
    Set pItem = FUniqueItems(uniqueKey)
    GetColumnUniques = pItem.GetColumnUniques(columnId)
End Function
Mergens, приношу свои извинения, предложил код не протестировав.
Изменено: Андрей VG - 11.02.2019 22:03:00
 
Андрей VG, Да какие могут быть извинения!!!
Вы мне с упрощением моей работы помогли, это я Вам должен спасибо говорить!
 
Цитата
Mergens написал:
Да какие могут быть извинения
Это мой косяк. Тут хочешь не хочешь, а признавать надо. Файл на всякий случай со второй версией изменений.
 
Цитата
Mergens написал: Вы мне с упрощением моей работы помогли
Mergens, А Вы не могли бы, ради спортивного интереса, потестировать решения других участников обсуждения на реальных данных?
Согласие есть продукт при полном непротивлении сторон
 
Sanja, я Ваш код тестировал, и он хорош, но не соответствует моей просьбе. Мне надо было это все дело запихнуть в словарь, как раз именно это и сделал Андрей VG, плюсом открылась еще необходимость извлечения конкретных значений присвоенных по ключу из внутренних словарей. В приложенном файле, в целевой области, это то что должно лежать в словаре, просто по другому никак не расписать(((. Вся обработка происходит в памяти, и словарь словарей, это промежуточная стадия, потом начинается раскладка по ключу словарей из словаря и применение их к области для формирования для запуска функциональности.
Есть такой старый продукт, SAP BexAnalyzer по сути оболочка работающая на Excel, вот там есть функциональность требующая создания областей планирования для запуска другой функциональности. вот для нее и пилю уже 2 недели гранит с 8 утра до 3х ночи.


А так Вам тоже Спасибо, и Спасибо Anchoret, я бы так не смог как Вы сообразить написать код(((( думалка видимо по проще((((
Изменено: Mergens - 11.02.2019 23:06:53
 
Mergens, А из 17 сообщения тоже не вариант?
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1
Наверх