[已解决]求每家店的最大值

pengxuanlan

求每家店的最大.zip (16.66 KB, 下载次数: 32)

2014-7-26 17:07 上传

点击文件名下载附件
麻烦帮我改下看，我写的不对
需要用VBA实现哦

最佳答案

月排行榜 / 总排行榜

易安1

2014-7-28 10:12

1. Sub test() '小易
   
2. Dim arr(1 To 10000), brr(1 To 10000)
   
3. Dim d As New Dictionary
   
4. 'Set d = CreateObject("scripting.dictionary")
   
5. Dim i As Integer, j As Integer
   
6. Columns("A:A").Copy [j1]
   
7. ActiveSheet.Columns("J:J").RemoveDuplicates Columns:=1, Header:=xlNo
   
8. For i = 2 To Cells(Rows.Count, "J").End(3).Row
   
9.     For j = 2 To Cells(Rows.Count, 1).End(3).Row
   
10.         If Cells(j, 1) = Cells(i, "J") Then
    
11.             d(j) = Cells(j, "G") * 1000 + j
    
12.         End If
    
13.     Next
    
14.     k = k + 1
    
15.     arr(k) = Val(Int(Application.Max(d.Items) / 1000)): brr(k) = Cells(Application.Max(d.Items) Mod 1000, "C")
    
16.     d.RemoveAll
    
17. Next
    
18. [k2].Resize(k, 2) = Application.Transpose(Array(brr, arr))
    
19. [k1:l1] = Array("店员名称", "结算额")
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

易安1

问题是数量呢 金额呢 要表述清楚

pengxuanlan

易安1 发表于 2014-7-26 17:12
问题是数量呢 金额呢 要表述清楚

结算额。然后要把对应的商店和姓名取出来  有用的列是第一列，第三列和第7列

xdragon

pengxuanlan

xdragon 发表于 2014-7-26 17:15

需要用VBA哦，用数据透视表我知道怎么弄

孤单无所谓

=MAX(IF($A$2:$A$230=$a2,D$2:D$230)),在H2输入后按ctrl+shift+enter 右拉下拉

xdragon

1. Sub Test()
   
2.     Dim arr, d As Object, i&
   
3.     arr = Range("A1").CurrentRegion.Value
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For i = 1 To UBound(arr)
   
6.        If arr(i, 7) > d(arr(i, 1)) Then d(arr(i, 1)) = arr(i, 7)
   
7.     Next
   
8.     Range("I2").Resize(d.Count) = Application.Transpose(d.keys)
   
9.     Range("J2").Resize(d.Count) = Application.Transpose(d.items)
   
10. End Sub

复制代码

易安1

{:22:}

孤单无所谓

1. Sub myMax()
   
2.     arr = Sheet1.Range("a2:g" & Sheet1.Range("a65536").End(3).Row).Value
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     For i = 1 To UBound(arr)
   
5.         If d.exists(arr(i, 1)) Then
   
6.             If d(arr(i, 1)) < arr(i, 7) Then d(arr(i, 1)) = arr(i, 7)
   
7.         Else
   
8.             d(arr(i, 1)) = arr(i, 7)
   
9.         End If
   
10.     Next
    
11.     ReDim brr(1 To d.Count, 1 To 2)
    
12.     k = d.keys
    
13.     For i = 1 To UBound(k) + 1
    
14.         brr(i, 1) = k(i - 1)
    
15.         brr(i, 2) = d(k(i - 1))
    
16.     Next
    
17.     Sheet1.Range("k2:l" & d.Count + 1) = brr
    
18. End Sub

复制代码

pengxuanlan

孤单无所谓 发表于 2014-7-26 17:31

名字怎么没有过来呢，第三列的