[已解决]如何用VBA从左边来源整理成右边那样的数据呢 ?

lewis16888

请老师跟版主帮忙,谢了

F列按照顺序由大到小排列,如果长跟宽一样只出现一笔,且数量相加

最佳答案

月排行榜 / 总排行榜

dongqing1998

2012-7-5 18:10

1. 
   
2. Sub 汇总()
   
3.     Dim arr, i, d, brr(), atmp
   
4.     arr = Range("b2:d" & Range("b65536").End(3).Row)
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     For i = 1 To UBound(arr)
   
7.         d(arr(i, 1) & " " & arr(i, 2)) = d(arr(i, 1) & " " & arr(i, 2)) + arr(i, 3)
   
8.     Next
   
9.     atmp = d.keys
   
10.     ReDim brr(1 To 3, 0 To d.Count)
    
11.     brr(1, 0) = "长": brr(2, 0) = "宽": brr(3, 0) = "数量"
    
12.     For i = 1 To d.Count
    
13.         brr(1, i) = Split(atmp(i - 1), " ")(0)
    
14.         brr(2, i) = Split(atmp(i - 1), " ")(1)
    
15.         brr(3, i) = d(atmp(i - 1))
    
16.     Next
    
17.     Application.ScreenUpdating = False
    
18.     With Range("f1:h" & d.Count + 1)
    
19.         .ClearContents
    
20.         .Value = Application.Transpose(brr)
    
21.         .Sort Key1:=Range("f2"), Order1:=xlDescending, Key2:=Range("g2"), _
    
22.             Order2:=xlDescending, Key3:=Range("h2"), Order3:=xlDescending
    
23.     End With
    
24.     Application.ScreenUpdating = True
    
25. End Sub
    

复制代码

Book122.rar (11.65 KB, 下载次数: 7)

2012-7-5 18:08 上传

点击文件名下载附件

跳转到最佳答案楼层

QLZ0602

可用数据透视表方法实现 ,具体做法网上查

银鱼

关键还要排序，如果只是取数会简单很多

gdsgzhrsh

看看是不是你想要的~~~~~~

dongqing1998

1. 
   
2. Sub 汇总()
   
3.     Dim arr, i, d, brr(), atmp
   
4.     arr = Range("b2:d" & Range("b65536").End(3).Row)
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     For i = 1 To UBound(arr)
   
7.         d(arr(i, 1) & " " & arr(i, 2)) = d(arr(i, 1) & " " & arr(i, 2)) + arr(i, 3)
   
8.     Next
   
9.     atmp = d.keys
   
10.     ReDim brr(1 To 3, 0 To d.Count)
    
11.     brr(1, 0) = "长": brr(2, 0) = "宽": brr(3, 0) = "数量"
    
12.     For i = 1 To d.Count
    
13.         brr(1, i) = Split(atmp(i - 1), " ")(0)
    
14.         brr(2, i) = Split(atmp(i - 1), " ")(1)
    
15.         brr(3, i) = d(atmp(i - 1))
    
16.     Next
    
17.     Application.ScreenUpdating = False
    
18.     With Range("f1:h" & d.Count + 1)
    
19.         .ClearContents
    
20.         .Value = Application.Transpose(brr)
    
21.         .Sort Key1:=Range("f2"), Order1:=xlDescending, Key2:=Range("g2"), _
    
22.             Order2:=xlDescending, Key3:=Range("h2"), Order3:=xlDescending
    
23.     End With
    
24.     Application.ScreenUpdating = True
    
25. End Sub
    

复制代码

Book122.rar (11.65 KB, 下载次数: 7)

2012-7-5 18:08 上传

点击文件名下载附件