Como categorizar e concatenar valores no Excel

Question

Eu tenho uma lista de pedidos e quero descobrir que ano (s) o cliente fez pedidos.

Então, minha lista é algo assim:

Year, Customer, Total
2016, CusA, 100
2016, CusA, 200
2017, CusA, 300
2016, CusB, 100
2017, CusC, 100

O resultado deve ser assim:

Customer, Year, Total
CusA, 2016;2017, 600
CusB, 2016, 100
CusC, 2017, 100

Isso é possível? Eu tentei usar o gráfico dinâmico. Mas só posso somar o ano, não listar os anos.

    

Answer 1

Você precisará usar o VBA para conciliar os valores encontrados em sua primeira coluna. Eu uso um UDF VBA encontrado aqui e mude o código um pouco.

Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long)
Dim r As Range
Dim result As String
result = ""
For Each r In lookuprange    
    If r = lookupval Then
        If result = "" Then
            result = r.Offset(0, indexcol - 1)
        Else
            result = result & ";" & r.Offset(0, indexcol - 1)
        End If
    End If
Next r
MYVLOOKUP = result
End Function

Suponha que seus dados estejam organizados como nesta imagem , insira a seguinte fórmula em H4: =IFERROR(INDEX(B4:B8,MATCH(0,COUNTIF($H$3:H3,B4:B8),0)),"")

Pressione: CTRL + SHIFT + ENTER para a fórmula ser aceita como uma fórmula de matriz (ela terá chaves) e arraste a fórmula para baixo.

Em I4, insira a fórmula: =MYVLOOKUP(H4,B4:B9,0)

E em J4: =SUMIF(B4:C9,H4,C4:C9)

Não esqueça de arrastar as fórmulas para baixo quando necessário.

    

Answer 2

Esta macro gera a saída esperada. Difere da versão aceita que ordena os anos que são delimitados em ordem crescente. Eu testei com meio milhão de registros e demorou alguns segundos para ser concluído. Espero que você goste:)

Option Explicit

Sub transformTable()
' INPUT
' assumes that data start in cell A1
' assumes there is a header in the first row
' assumes that there are no blank rows in between the rows
' OUTPUT
' assumes that result table is saved in the same sheet and starts in column 6
' assumes that in the output table years must be in ascending order

Dim del As String
del = ";"
Dim arrYears() As String
Dim i, j, k, l, col As Double
Dim noOfRows As Long
Dim cCustomer As String 'c means column
Dim cYear As Double
Dim cTotal As Double
Dim tmpTotal As String
Dim tmpYear As String
Dim newDelimitedYear As String
Dim key As Variant

'identify no of rows with data
i = 1
Do While Len(Cells(i, 1).Value) > 0
    i = i + 1
Loop
noOfRows = i - 1

Dim dictYear As Object 'Declare the Dictionary object
Set dictYear = CreateObject("Scripting.Dictionary") 'Create the Dictionary

Dim dictTotal As Object 'Declare the Dictionary object
Set dictTotal = CreateObject("Scripting.Dictionary") 'Create the Dictionary

' loop by second column - Customer
For i = 2 To noOfRows
    cCustomer = Trim(Cells(i, 2))
    cYear = Trim(Cells(i, 1))
    cTotal = Trim(Cells(i, 3))

    'TOTAL
    If Not dictTotal.Exists(cCustomer) Then
        dictTotal.Add cCustomer, cTotal
    Else
        tmpTotal = dictTotal(cCustomer)
        dictTotal(cCustomer) = CDbl(tmpTotal) + CDbl(cTotal)
    End If

    'YEAR
    If Not dictYear.Exists(cCustomer) Then
        dictYear.Add cCustomer, cYear
    Else 'single date without delimiter
        tmpYear = dictYear(cCustomer)
        If InStr(tmpYear, del) = 0 Then
            If tmpYear = cYear Then
                'Do nothing
            ElseIf tmpYear > cYear Then
                newDelimitedYear = cYear & del & tmpYear
                dictYear(cCustomer) = newDelimitedYear
            Else
                newDelimitedYear = tmpYear & del & cYear
                dictYear(cCustomer) = newDelimitedYear
            End If
        Else 'dates with delimiter
            arrYears = Split(tmpYear, del)
            'sort years
            For j = LBound(arrYears) To UBound(arrYears)
                If arrYears(j) = cYear Then 'value already exists
                    Exit For
                ElseIf arrYears(0) > cYear Then 'value is lower than any existing value
                    newDelimitedYear = cYear & del & tmpYear
                    dictYear(cCustomer) = newDelimitedYear
                    Exit For
                ElseIf arrYears(UBound(arrYears)) < cYear Then 'value is higher than any other existing value
                    newDelimitedYear = tmpYear & del & cYear
                    dictYear(cCustomer) = newDelimitedYear
                'value does not exist but needs to be put in ascending order
                ElseIf j < UBound(arrYears) Then
                    If cYear > arrYears(j) And cYear > arrYears(j + 1) Then
                        'Do nothing
                    ElseIf cYear > arrYears(j) And cYear < arrYears(j + 1) Then 'put the new value in j+1 position, and move j+1 to j+2
                        'years ascending
                        For k = LBound(arrYears) To UBound(arrYears)
                            If j <> k And k < j Then
                                newDelimitedYear = newDelimitedYear & arrYears(k) & del
                            ElseIf j = k Then
                                newDelimitedYear = newDelimitedYear & arrYears(k) & del & cYear & del
                                For l = j + 1 To UBound(arrYears) - 1
                                    newDelimitedYear = newDelimitedYear & arrYears(l) & del
                                Next
                                    newDelimitedYear = newDelimitedYear & arrYears(UBound(arrYears))
                                    Exit For
                            End If
                        Next
                        dictYear(cCustomer) = newDelimitedYear
                        Exit For
                    End If
                End If
            Next
        End If
    End If
newDelimitedYear = ""
Next i

'Present data in Excel Sheet
col = 6
'HEADERS
Cells(1, col).Value = "Customer"
Cells(1, col + 1) = "Year"
Cells(1, col + 2) = "Total"
'DATA ROWS
i = 1
For Each key In dictYear.Keys
   Cells(i + 1, col).Value = key
   Cells(i + 1, col + 1).Value = dictYear(key)
   Cells(i + 1, col + 2).Value = dictTotal(key)
   i = i + 1
Next key

'clear cells if next rows are not blank (due to previous macro run with more number of rows)
If Cells(i + 1, col).Value <> "" Then
    Do While Cells(i + 1, col).Value <> ""
        Cells(i + 1, col).Value = ""
        Cells(i + 1, col + 1).Value = ""
        Cells(i + 1, col + 2).Value = ""
        i = i + 1
    Loop
End If
End Sub