這樣好了
Sub test()
Dim i As Integer, arr, brr(1 To 12, 1 To 1)
Sheets(2).Activate
arr = [a1].CurrentRegion
For i = 1 To UBound(arr)
Select Case arr(i, 1)
Case Is <= 300
brr(1, 1) = brr(1, 1) + 1
Case Is <= 1000
brr(2, 1) = brr(2, 1) + 1
Case Is <= 1500
brr(3, 1) = brr(3, 1) + 1
Case Is <= 2000
brr(4, 1) = brr(4, 1) + 1
Case Is <= 3000
brr(5, 1) = brr(5, 1) + 1
Case Is <= 4000
brr(6, 1) = brr(6, 1) + 1
Case Is <= 5000
brr(7, 1) = brr(7, 1) + 1
Case Is <= 6000
brr(8, 1) = brr(8, 1) + 1
Case Is <= 7000
brr(9, 1) = brr(9, 1) + 1
Case Is <= 8000
brr(10, 1) = brr(10, 1) + 1
Case Is <= 9000
brr(11, 1) = brr(11, 1) + 1
Case Is <= 10000
brr(12, 1) = brr(12, 1) + 1
End Select
Next i
Sheets(1).Activate
[h2].Resize(12, 1) = brr
End Sub
|