Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сбор уникальных значений
 
#1
20.11.2021 13:59:22
Приветствую, мастера VBA))
нужна ваша помощь))
помогите написать макрос сбора значений в ячеку: сначала находим уникальные значения по столбцу С, далее к этому уникальному значению находим уникальные значения из столбца В, и все это помещаем в ячейку.
пример как должно быть в итоге внес в ячеку G2.
С помощью коллекции могу собрать уни-ные знач из одного столбца, а вот так как описал выше, не хватает знаний и навыков. помогите пожалуйста.
во вложении DATA
 
 
 
#2
20.11.2021 14:17:16
Код
Sub test()
    Dim i As Long, Dict As Object, arrData, strResult As String, iKey

    arrData = Range("A1").CurrentRegion
    Set Dict = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(arrData)
        Dict(arrData(i, 3)) = 0&
    Next i
    
    For Each iKey In Dict.keys
        strResult = strResult & iKey & ": "
        For i = 2 To UBound(arrData)
            If arrData(i, 3) = iKey Then strResult = strResult & arrData(i, 2) & "; "
        Next i
        strResult = Left(strResult, Len(strResult) - 1)
        strResult = strResult & Chr(10)
    Next iKey
    
    Range("G10") = Left(strResult, Len(strResult) - 1)
End Sub
Изменено: New - 20.11.2021 14:18:28
 
 
 
#3
20.11.2021 14:20:23
Код
Sub bb()
  Dim d, a, r&, ks
  Set d = CreateObject("Scripting.Dictionary")
  a = [a1].CurrentRegion
  For r = 2 To UBound(a)
    If d.Exists(a(r, 3)) Then
      d(a(r, 3)) = d(a(r, 3)) & "; " & a(r, 2)
    Else
      d(a(r, 3)) = a(r, 2)
    End If
  Next
  ks = d.Keys: a = ""
  For r = 0 To UBound(ks)
    a = a & ks(r) & ": " & d(ks(r)) & vbLf
  Next
  [g2] = a
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#4
20.11.2021 14:53:14
вариант на pq:
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    a = Text.Combine(Table.Group(Source, {"Диаметр и толщина"}, {"q", each [Диаметр и толщина]{0} & " : " & Text.Combine(List.Distinct([Номер стыка]), "; ")})[q], "#(lf)")
in
    a
 
 
 
Страницы: 1
Наверх