在第1列中查看值并显示第2列值

时间:2016-06-20 13:33:19

标签: vba excel-vba excel

我的数据集看起来像

Col A   
A/05702; A/05724; A/05724;A/05724;A/05725;A/05725;
corresponding Col B
1;1;2;3;1;3;

我想把结果作为

Col C
A/05702;A/5724;A05725

和相应的

 ColD1; 1,2,3; 1,3

这将在COLA中查找相同的值,然后如果发现COLB值变为COLD并以“,”分隔

感谢任何帮助。

3 个答案:

答案 0 :(得分:3)

您绝对可以利用Microsoft Scripting Runtime库中的Dictionary对象。使用Tools-> References在VBE中添加引用。

基本上,字典允许您根据唯一键存储值。您还希望创建一组唯一键,但在遇到该键的新行时,请继续追加该键的值。

以下是代码:

Option Explicit

Sub GenerateSummary()
    Dim wsSource As Worksheet
    Dim rngSource As Range
    Dim rngTarget As Range
    Dim lngRowCounter As Long
    Dim objData As New Dictionary
    Dim strKey As String, strValue As String

    'get source data
    Set wsSource = ThisWorkbook.Worksheets("Sheet2")
    Set rngSource = wsSource.Range("A1:B" & wsSource.Range("A1").CurrentRegion.Rows.Count)

    'analyse data
    For lngRowCounter = 1 To rngSource.Rows.Count
        'get key/ value pair
        strKey = rngSource.Cells(lngRowCounter, 1).Value
        strValue = rngSource.Cells(lngRowCounter, 2).Value
        'if key exists - add to value; else create new key/ value pair
        If objData.Exists(strKey) Then
            objData(strKey) = objData(strKey) & ", " & strValue
        Else
            objData.Add strKey, strValue
        End If
    Next lngRowCounter

    'output dictionary to target range
    'nb dictionary is zero-based index
    Set rngTarget = wsSource.Range("C1")
    For lngRowCounter = 1 To objData.Count
        rngTarget.Cells(lngRowCounter, 1).Value = objData.keys(lngRowCounter - 1)
        rngTarget.Cells(lngRowCounter, 2).Value = objData(objData.keys(lngRowCounter - 1))
    Next lngRowCounter

End Sub

更新

为清楚起见,我将发布我输入的数据的屏幕截图以测试此代码。所以,在我的Sheet2 - 这是一个全新的,没有任何其他数据 - 我已经获得了这些条目:

enter image description here

然后在运行宏之后,它看起来像这样:

enter image description here

答案 1 :(得分:2)

您可以使用这个简单的UDF:

Function TEXTJOIN(delim As String, skipblank As Boolean, arr) As String
    Dim d
    For Each d In arr
        If d <> "" Or Not skipblank Then
            TEXTJOIN = TEXTJOIN & d & delim
        End If
    Next d
    TEXTJOIN = Left(TEXTJOIN, Len(TEXTJOIN) - 1)
End Function

确保将其放在附加到所需工作簿的模块中,并在工作表代码或ThisWorkbook代码中 NOT

然后像这样调用:

=TEXTJOIN(",",TRUE,IF($A$1:$A$6 = $C1, $B$1:$B$6, ""))

使用Ctrl-Shift-Enter输入为数组公式。如果操作正确,Excel会将{}放在公式周围。

enter image description here

注意

如果您有Office 365,则不需要在Excel中存在UDF,只需将公式输入为数组。

<强>替代

如果您希望公式仅接近 AND ,您的数据将被排序,那么您将需要一个“帮助列”。我把我放在C栏中。在C1中我放了:

=IF(A2<>A1,B1,B1&"," &C2)

哪位给了我:

enter image description here

然后一个简单的VLOOKUP将返回我们想要的内容:

=VLOOKUP(E1,A:C,3,FALSE)

enter image description here

答案 2 :(得分:0)

您不需要vba,您可以使用数据透视表执行此操作:

Row Values:    Col A  
Column Values: Col B  
Values: Min of Col B

enter image description here

您可能需要一个UDF来轻松地连接这些值,但这也很简单:

Function JoinWithComma(cells As Range)

    Dim cell As Range, result As String

    For Each cell In cells
        If cell.Value <> "" Then
            result = result & cell.Value & ", "
        End If
    Next cell

    If Len(result) > 2 Then
        JoinWithComma = Left(result, Len(result) - 2)
    Else
        JoinWithComma = ""
    End If

End Function

enter image description here