Jak kategoryzować i konkatenować wartości w programie Excel

Mam listę zamówień i chcę sprawdzić, w którym roku (latach) klient złożył zamówienia.

Więc moja lista wygląda mniej więcej tak:

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

Wynik powinien wyglądać następująco:

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

czy to możliwe? Próbowałem użyć tabeli przestawnej. Ale jestem w stanie tylko podsumować rok, a nie wymienić lata.

Musisz użyć VBA, aby oddzielić wartości znalezione w pierwszej kolumnie. Używam znalezionego tutaj VBA UDF i trochę zmieniam kod.

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

Załóżmy, że twoje dane są zorganizowane jak na tym obrazku , wstaw następującą formułę w H4: =IFERROR(INDEX(B4:B8,MATCH(0,COUNTIF($H$3:H3,B4:B8),0)),"")

Naciśnij: CTRL + SHIFT + ENTERaby formuła została zaakceptowana jako formuła tablicowa (będzie miała nawiasy klamrowe), a następnie przeciągnij formułę w dół.

W I4 wprowadź wzór: =MYVLOOKUP(H4,B4:B9,0)

A w J4: =SUMIF(B4:C9,H4,C4:C9)

Nie zapomnij przeciągnąć formuł w razie potrzeby.

To makro generuje oczekiwany wynik. Różni się od przyjętej wersji tym, że sortuje lata, które są rozdzielane w porządku rosnącym. Przetestowałem go z pół milionem płyt i jego ukończenie zajęło kilka sekund. Mam nadzieję, że ci się spodoba :)

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