求一个归类的统计问题

dai3795739

希望哪位大侠帮忙把第一张表格归类统计成第二张中想要的结果，谢谢大侠了，具体见附件

dai3795739

其实很简单，但我就是转不过那个弯，希望哪位老师出手帮忙下，谢谢

laowuwyx

1. =SUMPRODUCT(N(问题!$B$2:$B$67&问题!$C$2:$C$67=$A2&B$1))

复制代码

dai3795739

能不能帮忙用VBA写个全的吗？谢谢老师了

xmyjk

1. Option Explicit
   
2. Sub samesum()
   
3. Dim i As Long, n As Long, arr(), j As Long, y As Long
   
4. Dim d, ds, k, t As Single
   
5. 
   
6. t = Timer
   
7. Worksheets(2).UsedRange.Offset(1).ClearContents
   
8. 
   
9. Set d = CreateObject("Scripting.Dictionary")
   
10. Set ds = CreateObject("Scripting.Dictionary")
    
11. n = Worksheets(1).[b65536].End(xlUp).Row
    
12. arr = Worksheets(1).Range("b2:c" & n).Value
    
13. 
    
14. For i = 1 To UBound(arr)
    
15.     d(arr(i, 1) & arr(i, 2)) = d(arr(i, 1) & arr(i, 2)) + 1
    
16.     ds(arr(i, 1)) = ds(arr(i, 1)) + 1
    
17. Next
    
18. 
    
19. k = ds.keys
    
20. Worksheets(2).[a2].Resize(ds.Count, 1) = Application.Transpose(k)
    
21. Erase k
    
22. Erase arr
    
23. 
    
24. n = Worksheets(2).[a65536].End(xlUp).Row
    
25. y = Worksheets(2).[iv1].End(xlToLeft).Column
    
26. 
    
27. arr = Worksheets(2).Range(Worksheets(2).Cells(1, 1), Worksheets(2).Cells(n, y)).Value
    
28. 
    
29. For i = 1 To UBound(arr, 1) - 1
    
30.     For j = 1 To UBound(arr, 2) - 1
    
31.        arr(i + 1, j + 1) = d(arr(i + 1, 1) & arr(1, j + 1))
    
32.     Next
    
33. Next
    
34. 
    
35. Worksheets(2).[a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
36. 
    
37. Erase arr
    
38. Set d = Nothing
    
39. Set ds = Nothing
    
40. 
    
41. MsgBox Timer - t & "秒"
    
42. End Sub
    
43. 
    

复制代码

xmyjk

试看看附件。

xmyjk

我把表二行做成变动了，表二的行标签是你表一线路列的不重复唯一值，如果你表二的行标签也是固定的，那就更容易了，一个字典就搞定了。

xmyjk

1. Option Explicit
   
2. Sub test()
   
3. Dim cnn As Object, sql As String, BT As String
   
4. 
   
5. Application.ScreenUpdating = False
   
6. Worksheets(2).UsedRange.Offset(1).ClearContents
   
7. Set cnn = CreateObject("ADODB.Connection")
   
8. cnn.Open "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
   
9. sql = "TRANSFORM count(类型) SELECT 线路名称 FROM [问题$] GROUP BY 线路名称 PIVOT 类型 in (原因不明,外力短路,设备老化,变台故障,用户责任,运行不当,施工质量,管理不当,维护质量,制造质量)"
   
10. Worksheets(2).[a2].CopyFromRecordset cnn.Execute(sql)
    
11. cnn.Close: Set cnn = Nothing
    
12. Application.ScreenUpdating = True
    
13. MsgBox "Ok"
    
14. End Sub
    
15. 
    

复制代码

xmyjk

两种方法都做进去了，自己玩玩吧。

dai3795739

你真是太厉害了，行，我好好琢磨下，谢谢老师帮助