☰

如何获取一列中每组相同值的另一列中存在的唯一值？

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 worksheet-function microsoft-excel-2007 vba
如何获取一列中每组相同值的另一列中存在的唯一值？

我有以下两列：

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 编码？

答案1

您可以尝试这种方法。它利用用户定义类来帮助收集第二列中的唯一项目。

常规模块和类模块中的代码都利用了这样一个事实：当您尝试向集合中添加具有与现有成员相同键的成员时，457将生成错误。

您可以在代码中看到需要在哪里进行更改以解决工作表和源（Src）与结果（Res）范围的差异。

您必须重命名类模块cConBy。之后Insert Class Module，F4打开属性窗口。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 值仍会存在，但不可见。

在此处输入图片描述

答案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。选择“分隔

答案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作为第二个选项。_在这种情况下，您的分隔符是。

这将为您提供接近您想要的结果。

相关内容