Как получить уникальные значения, присутствующие в столбце, для каждого набора идентичных значений в другом столбце?

Question

У меня есть следующие две колонки:

Con.By  Prod
   A     1
   A     1
   A     2
   A     2
   B     1
   B     1
   B     2
   B     2

Я могу легко получить уникальные значения либо в столбце, Con.Byлибо в столбце Prod. Однако мое требование состоит в том, чтобы получить уникальные значения в столбце Prodдля каждого из уникальных значений в столбце Con.By. Следовательно, мой предполагаемый вывод для вышеуказанных столбцов данных будет следующим:

Con.By  Prod
   A     1
         2
   B     1
         2

Я даже не уверен, с чего начать. Я попытался написать код VBA для фильтрации столбцов Con.Byпо каждому значению отдельно, а затем найти уникальные значения в Prodстолбце. Однако этот метод не работает, так как мой Con.Byстолбец содержит слишком много записей, и некоторые из них могут измениться со временем.

Как лучше всего получить нужный мне вывод? Есть ли формулы Excel или требуется кодирование VBA?

Answer 1

Вы можете попробовать этот метод. Он использует пользовательский класс, чтобы помочь в сборе уникальных элементов во втором столбце.

Код как в модулях Regular, так и в модулях Class использует тот факт, что при попытке добавить в коллекцию элемент, имеющий тот же ключ, что и существующий элемент, 457будет сгенерирована ошибка.

В коде вы можете увидеть, где вносить изменения, чтобы учесть различия в вашем рабочем листе и диапазонах для Источника (Src) и Результатов (Res).

Вы должны ПЕРЕИМЕНОВАТЬ модуль класса cConBy. После того, как вы Insert Class Module,Ф4Открывается окно свойств. Измените Nameтам параметр.

Модуль класса

---

Option Explicit
Private pConBy As String
Private pProd As String
Private pProds As Collection

Private Sub Class_Initialize()
    Set pProds = New Collection
End Sub

Public Property Get ConBy() As String
    ConBy = pConBy
End Property
Public Property Let ConBy(Value As String)
    pConBy = Value
End Property

Public Property Get Prod() As String
    Prod = pProd
End Property
Public Property Let Prod(Value As String)
    pProd = Value
End Property

Public Function AddProd(Value As String)
    On Error Resume Next
    pProds.Add Value, CStr(Value)
    On Error GoTo 0
End Function

Public Property Get Prods() As Collection
    Set Prods = pProds
End Property

---

Регулярный модуль

---

Option Explicit
Sub UniqueConBy()
    Dim cCB As cConBy, colCB As Collection
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes() As Variant
    Dim I As Long, J As Long, K As Long
    Dim lRowCount As Long

'Source and results location
Set wsSrc = Worksheets("Sheet1")
Set wsRes = Worksheets("Sheet1")
    Set rRes = wsRes.Cells(1, 5)
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2)
End With

'Collect and consolidate the data
Set colCB = New Collection
On Error Resume Next
For I = 2 To UBound(vSrc, 1)
    Set cCB = New cConBy
    With cCB
        .ConBy = vSrc(I, 1)
        .Prod = vSrc(I, 2)
        .AddProd .Prod
        lRowCount = lRowCount + 1
        colCB.Add cCB, CStr(.ConBy)
        Select Case Err.Number
            Case 457
                With colCB(CStr(.ConBy))
                    lRowCount = lRowCount - .Prods.Count - 1
                    .AddProd cCB.Prod
                    lRowCount = lRowCount + .Prods.Count
                End With
                Err.Clear
            Case Is <> 0
                MsgBox "Error: " & Err.Number & vbTab & Err.Description
                Stop
        End Select
    End With
Next I
On Error GoTo 0

'Create results array
ReDim vRes(0 To lRowCount, 1 To 2)

'column labels
For I = 1 To UBound(vRes, 2)
    vRes(0, I) = vSrc(1, I)
Next I

'populate the array
For I = 1 To colCB.Count
    With colCB(I)
        K = K + 1
        vRes(K, 1) = .ConBy
        vRes(K, 2) = .Prods(1)
        For J = 2 To .Prods.Count
            K = K + 1
            vRes(K, 2) = .Prods(J)
        Next J
    End With
Next I

Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    With .Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    .EntireColumn.AutoFit
End With

End Sub

---

РЕДАКТИРОВАТЬ:

Альтернативный метод, который близок к тому, что вам нужно, но дает немного другой результат, — просто использовать опцию «Удалить дубликаты» на вкладке «Лента данных» / «Инструменты данных». Вам нужно выбрать оба столбца A и B.

Перед применением этого метода убедитесь, что ваши данные отсортированы (при использовании метода VBA сортировка не требуется).

С учетом опубликованных вами данных результаты будут выглядеть следующим образом:

Вы можете использовать условное форматирование, чтобы исключить дублирующие записи в столбце A. Например: используйте формулу =$A2=$A1 и отформатируйте цвет текста так, чтобы он был того же цвета, что и фон. Значение Con.By все еще будет там, но не будет видно.

Answer 2

Попробуйте следующий рецепт, который, на мой взгляд, легче понять, но, возможно, не так удобен для автоматизации, как ответ Рона.

1. Предположим, Con.Byчто находится в столбце A, а Prodнаходится в столбце B, в другом столбце (например, C), объедините два столбца с помощью разделителя, например, «_»:

   =A2&"_"&B2что то же самое, что и=CONCATENATE(A2,"_",B2)

2. Используя ваш пример, вывод будет таким A_1и т.д. Скопируйте столбец C и Paste Valuesтолько в столбец D.

3. Выделите столбец D и с помощью ленточного меню выберите Data -> Remove Duplicates. Столбец D будет выглядеть так: A_1 A_2

4. Чтобы разделить данные обратно на два отдельных столбца, используйте меню ленты и выберите Data -> Text to Columns. Выберите `Разделенные

Answer 3

Попробуйте следующий рецепт, который, на мой взгляд, легче понять, но, возможно, не так удобен для автоматизации, как ответ Рона.

1. Предположим, Con.Byчто находится в столбце A, а Prodнаходится в столбце B, в другом столбце (например, C), объедините два столбца с помощью разделителя, например, «_»:

   =A2&"_"&B2что то же самое, что и=CONCATENATE(A2,"_",B2)

2. Используя ваш пример, вывод будет таким A_1и т.д. Скопируйте столбец C и Paste Valuesтолько в столбец D.

3. Выделите столбец D и с помощью ленточного меню выберите Data -> Remove Duplicates. Столбец D будет выглядеть так: A_1 A_2

4. Чтобы разделить данные обратно на два отдельных столбца, используйте меню ленты и выберите Data -> Text to Columns. Выберите Delimitedв качестве первого варианта и Otherв качестве второго. _В данном случае ваш разделитель — .

Это даст вам результаты, близкие к желаемым.