呵呵 有价值的来了。现在只需要数据表里按型号排序就行了。 查看效果话随意改几个 故障名称 :不开机2,不显示3,地区名: 广东3 ,型号:SM6123 Sub bbbb() Dim d2 As New Dictionary Dim d3 As New Dictionary Dim d4 As New Dictionary Cells.Interior.ColorIndex = Empty r = Sheet2.Range("a2").End(xlDown).Row - 1 '排序可以用excel的排序,这个也不许用的话,就再套一个字典,这比绕口令还复杂的绕“脑”令, '有需要的人自己去绕吧 Sheet2.Range("a2").Resize(r, 3).Sort Key1:=Sheet2.Range("B2"),Order1:=xlDescending arr = Sheet2.Range("a2").Resize(r, 3) For i = 1 To r For j = 1 To 3 arr(i, j) = Trim(arr(i, j)) '文字净化处理 Next xh = arr(i, 2) gz = arr(i, 3) d2(xh) = d2(xh) + 1 If d3.Exists(xh) = False Then Set d3(xh) = New Dictionary s = d3(xh)(gz) xhgz = arr(i, 2) & " " & arr(i, 3) ' 型号 故障 If d4.Exists(xhgz) = False Then Set d4(xhgz) = New Dictionary d4(xhgz)(arr(i, 1)) = d4(xhgz)(arr(i, 1)) + 1 Next Erase arr ReDim ar(1 To (d2.Count + d4.Count), 1 To 11) i = 0 ii = 0 For Each K In d4 xh = Split(K)(0) gz = Split(K)(1) i = i + 1 xii = d3(xh).Count ii = ii + 1 ar(i, 1) = ii ar(i, 2) = xh ar(i, 3) = gz For Each KK In d4(K) ar(i, 4) = ar(i, 4) + d4(K)(KK) If d4(K)(KK) >= ar(i, 7) Then ar(i, 10) = ar(i, 8): ar(i, 11) = ar(i, 9) ar(i, 8) = ar(i, 6): ar(i, 9) = ar(i, 7) ar(i, 6) = KK: ar(i, 7) = d4(K)(KK) ElseIf d4(K)(KK) >= ar(i, 9) Then ar(i, 10) = ar(i, 8): ar(i, 11) = ar(i, 9) ar(i, 8) = KK: ar(i, 9) = d4(K)(KK) ElseIf d4(K)(KK) > ar(i, 11) Then ar(i, 10) = KK: ar(i, 11) = d4(K)(KK) End If Next ar(i, 5) = ar(i, 4) / d2(xh) If ar(i, 1) = d3(xh).Count Then i = i + 1 ar(i, 1) = ii + 1 ar(i, 2) = xh ar(i, 3) = "合计" ar(i, 4) = d2(xh) ar(i, 5) = "100%" ii = 0 s = s & " " & i End If Next Range("a3").Resize(UBound(ar), 11) = ar arr = Split(s) For i = 1 To UBound(arr) Cells(arr(i) + 2, 1).Resize(1, 11).Interior.ColorIndex = 43 Next End Sub
[此贴子已经被作者于2007-11-27 20:09:45编辑过] |