Look Values in column 1 and bring column 2 values

后端 未结 3 1006
[愿得一人]
[愿得一人] 2020-12-11 14:39

my data set looks like

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

I am trying to get the

相关标签:
3条回答
  • 2020-12-11 14:57

    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.

    Here's the code:

    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
    

    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:

    0 讨论(0)
  • 2020-12-11 14:57

    You can use this simple 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
    

    Make sure to put it in a module attached to the desired workbook and NOT in the worksheet code or in ThisWorkbook code.

    It is then called like this:

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

    Entered as an Array formula with Ctrl-Shift-Enter. If done correctly Excel will put {} around the formula.


    NOTE

    If you have Office 365 the UDF is not needed as it exists in Excel, Just enter the formula as an array.


    Alternative

    If you want a formula only approach AND your data is sorted then you will need a "helper column". I put mine in Column C. In C1 I put:

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

    Which gave me:

    Then a simple VLOOKUP will return what we want:

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

    0 讨论(0)
  • 2020-12-11 15:09

    You don't NEED vba, you can do this with a pivot table:

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

    You might need a UDF to concatenate the values easily, but that would be pretty simple too:

    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
    

    0 讨论(0)
提交回复
热议问题