1

У меня есть список заказов и я хочу узнать, в каком году заказчики разместили заказы.

Итак, мой список выглядит примерно так:

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

Результат должен быть таким:

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

Это возможно? Я пытался использовать сводную диаграмму. Но я могу только суммировать год, а не перечислять годы.

2 ответа2

1

Вам нужно будет использовать VBA, чтобы объединить значения, найденные в первом столбце. Я использую VBA UDF, найденную здесь, и немного изменяю код.

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

Предположим, что ваши данные организованы, как на этом изображении, вставьте следующую формулу в H4:=IFERROR(INDEX(B4:B8,MATCH(0,COUNTIF($H$3:H3,B4:B8),0)),"")

Нажмите: CTRL + SHIFT + ENTER чтобы формула была принята как формула массива (она будет иметь фигурные скобки), затем перетащите формулу вниз.

В I4 введите формулу:=MYVLOOKUP(H4,B4:B9,0)

И в J4:=SUMIF(B4:C9,H4,C4:C9)

Не забудьте перетащить формулы вниз, где это необходимо.

0

Этот макрос генерирует ожидаемый результат. Он отличается от принятой версии тем, что сортирует годы, которые разграничиваются в порядке возрастания. Я протестировал его с полмиллиона записей, и мне потребовалось несколько секунд, чтобы завершить его. Надеюсь, вам понравится :)

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

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .