|
本帖最后由 mate66 于 2017-8-15 11:35 编辑
多区域统计个数的VBA.
- Sub main()
- Dim rng As Range, RngColor As Range
- Set rng = Range("g15") '自选单元格改为:set rng=selection
- mycolor = Array(0, 3, 33, 10, 6) '颜色出现的次序,从第二个开始。
- ActiveSheet.UsedRange.Cells.Interior.ColorIndex = 0
- rng.Interior.ColorIndex = 6
- Range("b35:ar1000") = ""
- For k = 1 To 4
- If k = 1 Then
- Set RngColor = rng.Offset(10, 3).Resize(5, 12)
- ElseIf k = 2 Then
- Set RngColor = rng.Offset(3, 3).Resize(4, 12)
- ElseIf k = 3 Then
- Set RngColor = rng.Offset(-3, 13).Resize(5, 18)
- Else
- Set RngColor = rng.Offset(4, 21).Resize(5, 14)
- End If
- RngColor.Interior.ColorIndex = mycolor(k)
- c = RngColor.Column
- rmax = Cells(65536, c).End(3).Row + 2
- Cells(rmax, c).Resize(10, 2) = 统计个数(RngColor)
- Cells(rmax, c).Resize(10, 2).Interior.ColorIndex = mycolor(k)
- Next
- End Sub
- Function 统计个数(rng As Range)
- Dim arr(9, 1 To 2), x As Range
- For Each x In rng
- y = x.Value
- arr(x, 1) = x
- arr(x, 2) = arr(x, 2) + 1
- Next
- For i = 0 To 8
- For j = i + 1 To 9
- If arr(j, 2) > arr(i, 2) Then
- tmp = arr(i, 2): arr(i, 2) = arr(j, 2): arr(j, 2) = tmp
- tmp = arr(i, 1): arr(i, 1) = arr(j, 1): arr(j, 1) = tmp
- End If
- Next
- Next
- 统计个数 = arr
- End Function
复制代码
|
|