Блог

Я работаю с нижеприведенным набором данных. Для каждой компании я хотел бы понять, сколько разных продуктов они заказывают.

Например: компания » ААА » заказывает 6 различных продуктов (Продукт 1,2,3,4,5,7).

Не уверен, нужно ли нам разбивать слова в каждом столбце, а затем считать по одному в цикле, или есть какой-нибудь более быстрый метод? Здесь я должен использовать VBA, а мой набор данных превышает 100 тыс.

Вы могли бы, возможно, собрать что-то воедино, используя, предполагая, что данные в A1:C? :

 Sub Test()  Dim arr As Variant Dim lr As Long, x As Long, y As Long Dim dict1 As Object: Set dict1 = CreateObject("Scripting.Dictionary") Dim dict2 As Object: Set dict2 = CreateObject("Scripting.Dictionary")  'Get initial array (NOTE: implicit reference to the active worksheet) lr = Cells(Rows.Count, "A").End(xlUp).Row arr = Range("A2:C" amp; lr)  'Loop through array and fill dictionary For x = LBound(arr) To UBound(arr)  dict1(arr(x, 1)) = dict1(arr(x, 1)) amp; "," amp; arr(x, 3) Next  'Loop through dictionary and count unique items For y = 0 To dict1.Count - 1  For Each el In Split(dict1.Items()(y), ",")  dict2(el) = 1  Next  dict1(dict1.keys()(y)) = dict2.Count - 1  dict2.RemoveAll    'Check the result  Debug.Print dict1.keys()(y) amp; "-" amp; dict1.Items()(y) Next  End sub  

Пожалуйста, протестируйте следующий код. Он вернет (в приведенном выше коде на следующем листе, но может вернуть на любом листе) уникального клиента, за которым следует общее количество продуктов, а в следующих столбцах-заказанные продукты:

 Sub ProductsPerClient()  Dim sh As Worksheet, sh1 As Worksheet, lastR As Long, arr, arrSpl, arrFin, colMax As Long  Dim i As Long, j As Long, dict As Object    Set sh = ActiveSheet  Set sh1 = sh.Next 'use here the sheet you need  lastR = sh.Range("A" amp; sh.rows.count).End(xlUp).row  arr = sh.Range("A2:C" amp; lastR).value  Set dict = CreateObject("Scripting.Dictionary")  For i = 1 To UBound(arr)  arrSpl = Split(Trim(arr(i, 3)), ",")  If Not dict.Exists(arr(i, 1)) Then  dict.Add arr(i, 1), Join(arrSpl, "|")  If UBound(arrSpl)   1 gt; colMax Then colMax = UBound(arrSpl)   1  Else  dict(arr(i, 1)) = dict(arr(i, 1)) amp; "|" amp; Join(arrSpl, "|")  If UBound(Split(dict(arr(i, 1)), "|"))   1 gt; colMax Then colMax = UBound(Split(dict(arr(i, 1)), "|"))   1  End If  Next i  ReDim arrFin(1 To dict.count, 1 To colMax   2)   For i = 0 To dict.count - 1  arrFin(i   1, 1) = dict.Keys()(i)  arrSpl = Split(dict.items()(i), "|")  arrFin(i   1, 2) = UBound(arrSpl)   1  For j = 0 To UBound(arrSpl)  arrFin(i   1, j   3) = arrSpl(j)  Next j  Next i  'drop the final array content:  sh1.Range("A2").Resize(UBound(arrFin), UBound(arrFin, 2)).value = arrFin  End Sub  

Этот ответ может показаться очень глупым, но поскольку вы разделяете разные продукты запятой, почему бы просто не посчитать количество запятых и не добавить 1, что-то вроде:

 =SEARCH(",",C2,1) 1  

Как только вы разместите это во вспомогательном столбце, вы сможете использовать базовую Subtotals функцию Excel для определения суммы на одного клиента.