[已解决]求助：冷热温号VBA统计

华华英雄

求助：冷热温号VBA统计.zip (359.26 KB, 下载次数: 4)

2015-9-23 09:17 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2015-9-23 10:32

1. Private Sub CommandButton2_Click()
   
2.     arr = [a1].CurrentRegion
   
3.     Dim brr(1 To 33)
   
4.     For Each x In arr
   
5.         brr(x) = brr(x) + 1
   
6.     Next
   
7.    
   
8.     ReDim crr(1 To 3, 0 To UBound(brr))
   
9.     crr(1, 0) = "热号": crr(2, 0) = "温号": crr(3, 0) = "冷号"
   
10.     For i = 1 To UBound(brr)
    
11.         If brr(i) > 2 Then
    
12.             n1 = n1 + 1: crr(1, n1) = i
    
13.         ElseIf brr(i) >= 1 Then
    
14.             n2 = n2 + 1: crr(2, n2) = i
    
15.         Else
    
16.             n3 = n3 + 1: crr(3, n3) = i
    
17.         End If
    
18.     Next
    
19.     n = Application.Max(n1, n2, n3)
    
20.     Range("I1:az3").ClearContents
    
21.     [I1].Resize(3, n + 1) = crr
    
22. End Sub

复制代码

跳转到最佳答案楼层

华华英雄

华华英雄

以前的VBA代码
Private Sub CommandButton2_Click()
Dim a(34) As Integer

Range("J1:az2").ClearContents
Cells(1, 9).Value = "热号"
Cells(2, 9).Value = "温号"
Cells(3, 9).Value = "冷号"

For i = 1 To 10
For j = 1 To 6
t = Val(Cells(i, j).Value)
a(t) = t
Next
Next


Columns("A:G").ColumnWidth = 2
Columns("J:AO").ColumnWidth = 2
Columns("AP:AP").ColumnWidth = 2
Columns("H:H").ColumnWidth = 16

t = 10: m = 10
For i = 1 To 33
If a(i) <> 0 Then
Cells(1, t).Value = a(i)
t = t + 1
ElseIf a(i) = 0 Then
Cells(2, m).Value = i
m = m + 1
End If
Next
End Sub

grf1973

1. Private Sub CommandButton2_Click()
   
2.     arr = [a1].CurrentRegion
   
3.     Dim brr(1 To 33)
   
4.     For Each x In arr
   
5.         brr(x) = brr(x) + 1
   
6.     Next
   
7.    
   
8.     ReDim crr(1 To 3, 0 To UBound(brr))
   
9.     crr(1, 0) = "热号": crr(2, 0) = "温号": crr(3, 0) = "冷号"
   
10.     For i = 1 To UBound(brr)
    
11.         If brr(i) > 2 Then
    
12.             n1 = n1 + 1: crr(1, n1) = i
    
13.         ElseIf brr(i) >= 1 Then
    
14.             n2 = n2 + 1: crr(2, n2) = i
    
15.         Else
    
16.             n3 = n3 + 1: crr(3, n3) = i
    
17.         End If
    
18.     Next
    
19.     n = Application.Max(n1, n2, n3)
    
20.     Range("I1:az3").ClearContents
    
21.     [I1].Resize(3, n + 1) = crr
    
22. End Sub

复制代码

grf1973

请看附件。