查看列1中的值，并带入列2值 [英] Look Values in column 1 and bring column 2 values

问题描述

我的数据集看起来像

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，用，分隔

This will look for same values in COLA, then if found COLB values goes to COLD and separated by ","

任何帮助都不胜感激。

Any help is appreciated.

推荐答案

您可以肯定地利用Microsoft脚本运行时的 Dictionary 图书馆。使用工具 - >参考在VBE中添加引用。

You can definitely leverage the Dictionary object from the Microsoft Scripting Runtime library. Add the the reference in your VBE with Tools->References.

基本上，字典允许您根据唯一键存储值。您还想创建一组唯一的键，但是当您遇到该键的新行时，会继续附加该键的值。

Basically, a dictionary allows you to store values against a unique key. You also want to create a set of unique keys but keep appending to the value for that key as you encounter new rows for that key.

以下是代码：

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 - 这是一个全新的和空的任何其他数据 - 我有这些条目：

Update

For clarity, I will post screenshots of the data I entered to test this code. So, on my Sheet2 - which was a totally new and empty of any other data - I've got these entries:

然后运行宏后，看起来像这样：

And then after running the macro, it looks like this:

这篇关于查看列1中的值，并带入列2值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！