楼主
liuguansky |
Q：如何依条件生成汇总排序选项卡？
根据条件，选择俗称跟月份得到每个月的的所有汇总情况。不良数是降序排序，汇总出前7项，超出的项目归为其它，不管数据源中“其它”的不良数有多少都是排在最后。生成示例如下所示：
A:用如下事件代码可以实现：
- Private Sub Worksheet_Change(ByVal Target As Range)
- If Target.Count > 1 Then Exit Sub
- If Target.Address(0, 0) = "B2" Or Target.Address(0, 0) = "E2" Then
- Application.EnableEvents = False
- Dim str1$, m%, rng As Range
- str1 = [b2]: m = [e2]
- Dim k&, arr1, arr2, lc&, br&, i&, j&, arrt()
- Dim str2$, dic, checkN&, badN&, t&, temp(1 To 3), n%
- Set dic = CreateObject("scripting.dictionary")
- With Sheet1
- lc = .Cells(3, 1).End(2).Column - 4
- Set rng = .Range("a:a").Find(str1, Range("A1"), , xlWhole)
- If rng Is Nothing Then MsgBox "未找到该俗称，请核实": Exit Sub
- br = rng.Row
- k = rng.MergeArea.Cells.Count + 1
- arr1 = .Cells(3, "e").Resize(1, lc).Value
- arr2 = .Cells(br, "c").Resize(k, lc + 2).Value
- End With
- For i = 1 To lc
- If Month(arr1(1, i)) = m Then
- checkN = checkN + arr2(k, i + 2)
- For j = 1 To k - 1
- str2 = arr2(j, 1) & vbTab & arr2(j, 2)
- badN = badN + arr2(j, i + 2)
- If Len(str2) > 0 Then
- If dic.exists(str2) Then
- arrt(3, dic(str2)) = arrt(3, dic(str2)) + arr2(j, i + 2)
- Else: t = t + 1: ReDim Preserve arrt(1 To 3, 1 To t)
- dic.Add str2, t: arrt(1, t) = arr2(j, 1): arrt(2, t) = arr2(j, 2): arrt(3, t) = arr2(j, i + 2)
- End If
- End If
- Next j
- End If
- Next i
- If t > 0 Then
- For i = 1 To t - 1
- For j = i + 1 To t
- If arrt(3, i) < arrt(3, j) And arrt(1, i) <> "其它" And arrt(1, j) <> "其它" Then
- For n = 1 To 3
- temp(n) = arrt(n, j)
- arrt(n, j) = arrt(n, i)
- arrt(n, i) = temp(n)
- Next n
- End If
- Next j, i
- If t > 8 Then
- For i = 9 To t
- arrt(1, 8) = "其他": arrt(2, 8) = ""
- arrt(3, 8) = arrt(3, 8) + arrt(3, i)
- Next
- End If
- End If
- ReDim Preserve arrt(1 To 3, 1 To 8)
- [b5] = checkN: [e5] = badN
- Range("b8:d15") = Application.Transpose(arrt)
- Set dic = Nothing
- Application.EnableEvents = True
- End If
- End Sub
具体示例文件如下：
|