提取唯一值并汇总数量

jiangyuqin1025

提取唯一值并汇总数量

苏小亓

1. =SUMIFS(D:D,B:B,F1,C:C,G1)

复制代码

苏小亓

直接透视也可以。
新建 XLS 工作表.zip (9.67 KB, 下载次数: 11)

2018-8-24 10:50 上传

点击文件名下载附件

jiangyuqin1025

苏小亓 发表于 2018-8-24 10:50

不要函数和透视

jiangyuqin1025

苏小亓 发表于 2018-8-24 10:50
直接透视也可以。

不要函数和透视

kankan1030

1. Sub Test()
   
2.     Dim Conn As Object, Rst As Object
   
3.     Dim strConn As String, strSQL As String
   
4.     Dim i As Integer, PathStr As String
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     PathStr = ThisWorkbook.FullName
   
8.     Select Case Application.Version * 1
   
9.     Case Is <= 11
   
10.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
11.     Case Is >= 12
    
12.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
13.     End Select
    
14.    
    
15.     strSQL = "select 产品,单位,sum(数量) from [sheet1$a1:d] group by 产品,单位"
    
16.     Conn.Open strConn
    
17.     Set Rst = Conn.Execute(strSQL)
    
18.     With Sheet1
    
19.         .Range("f1").CopyFromRecordset Rst
    
20.         .Cells.EntireColumn.AutoFit
    
21.     End With
    
22.     Rst.Close
    
23.     Conn.Close
    
24.     Set Conn = Nothing
    
25.     Set Rst = Nothing
    
26. End Sub

复制代码

hefuqing

1. Sub 汇总()
   
2. Dim d As Object
   
3. Dim Arr As Variant
   
4. Arr = Range("A2:d" & Range("a" & Rows.Count).End(xlUp).Row)
   
5. Dim i As Long
   
6. Set d = CreateObject("Scripting.dictionary")
   
7. For i = 1 To UBound(Arr)
   
8. d(Arr(i, 2)) = d(Arr(i, 2)) + Arr(i, 4)
   
9. Next i
   
10. Range("f1").Resize(d.Count) = Application.Transpose(d.keys)
    
11. Range("h1").Resize(d.Count) = Application.Transpose(d.items)
    
12. 
    
13. For i = 1 To UBound(Arr)
    
14. For j = 1 To Range("f" & Rows.Count).End(xlUp).Row
    
15. If Arr(i, 2) = Cells(j, 6) Then
    
16.   Cells(j, 7) = Arr(i, 3)
    
17.   End If
    
18.   Next
    
19.    Next
    
20.    
    
21. With Range("a1").CurrentRegion
    
22. .Borders.LineStyle = xlContinuous
    
23. .HorizontalAlignment = xlCenter
    
24. .VerticalAlignment = xlCenter
    
25. End With
    
26. End Sub

复制代码

hasyh2008

字典！！！

hasyh2008

Sub 汇总()
    Dim dic, X%, arr, dic2
    Range("F1").CurrentRegion.Clear
    arr = Range("A1").CurrentRegion
    Set dic = CreateObject("Scripting.dictionary")
    Set dic2 = CreateObject("Scripting.dictionary")
    For X = 1 To UBound(arr)
        dic(arr(X, 2)) = arr(X, 3)
        dic2(arr(X, 2)) = dic2(arr(X, 2)) + arr(X, 4)
    Next X
    Range("F1").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.keys)
    Range("G1").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.items)
    Range("H1").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic2.items)

End Sub