|
- Option Explicit
- Sub test()
- Dim arr
- arr = Range("a1").CurrentRegion.Value
- Dim d1 As Dictionary
- Dim dPrice As Dictionary
- Dim d2 As Dictionary
- Dim d3 As Dictionary
- Set d1 = New Dictionary
- Set dPrice = New Dictionary
- Set d2 = New Dictionary
- Set d3 = New Dictionary
- Dim i&, t#, str$
- t = Timer
- For i = 2 To UBound(arr)
- str = arr(i, 1) & "#" & arr(i, 2)
- If arr(i, 3) <> 999 Then
- '店面#单号
- ' '统计商品次数
- ' dCount(str & arr(i, 4)) = dCount(str & arr(i, 4)) + 1
- If d1.Exists(str) Then
- d1(str)(arr(i, 4)) = d1(str)(arr(i, 4)) + 1
- If arr(i, 5) > dPrice(str)(arr(i, 4)) Then
- dPrice(str)(arr(i, 4)) = arr(i, 5)
- End If
- Else
- '商品分类,次数
- d1.Add str, New Dictionary
- d1(str).Add arr(i, 4), 1
- '商品分类,价格
- dPrice.Add str, New Dictionary
- dPrice(str).Add arr(i, 4), arr(i, 5)
- End If
- Else
- d2.Add i, str
- End If
- Next
- Dim j
- For Each j In d2.Keys
- str = arr(j, 1) & "#" & arr(j, 2)
- Dim item1 As Dictionary
- Dim subkey, subitem
- Set item1 = d1(str)
- subkey = item1.Keys
- subitem = item1.Items
- If Not d3.Exists(str) Then
- If WorksheetFunction.Max(subitem) <> 1 Then
- Dim k&, lCountMax&, lCountStr
- lCountMax = subitem(0)
- lCountStr = subkey(0)
- For k = 1 To UBound(subitem)
- If lCountMax < subitem(k) Then
- lCountMax = subitem(k)
- lCountStr = subkey(k)
- End If
- Next
- d3.Add arr(j, 1) & "#" & arr(j, 2), lCountStr
- arr(j, 4) = lCountStr
- Else
- Set item1 = dPrice(str)
- subkey = item1.Keys
- subitem = item1.Items
- lCountMax = subitem(0)
- lCountStr = subkey(0)
- For k = 1 To UBound(subitem)
- If lCountMax < subitem(k) Then
- lCountMax = subitem(k)
- lCountStr = subkey(k)
- End If
- Next
- d3.Add str, lCountStr
- arr(j, 4) = lCountStr
- End If
- Else
- arr(j, 4) = d3(str)
- End If
- Next
- '结果数组,写入位置自行设置
- Range("h26").Resize(UBound(arr), UBound(arr, 2)).Value = arr
- End Sub
复制代码 楼主用大数据测测,看看是不是对的,现有的数据测出来是对的。
|
|