VBAの簡略化について

VBAで数値をカウントするマクロを作りました。

　Dim Co1 As Integer
Co1 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<1")


Dim Co2 As Integer
Co2 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<2")


Dim Co3 As Integer
Co3 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<3")


Dim Co4 As Integer
Co4 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<4")


Dim Co5 As Integer
Co5 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<5")


Dim Co6 As Integer
Co6 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<6")

Dim Co7 As Integer
Co7 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<7")

Dim Co8 As Integer
Co8 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<8")

Dim Co9 As Integer
Co9 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<9")

Dim Co10 As Integer
Co10 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), "<10")

Dim Co11 As Integer
Co11 = WorksheetFunction.CountIf(Range(Cells(○, ○), Cells(○, ○)), ">=10")


Cells(2, 1) = Co1
Cells(3, 1) = Co2 - Co1
Cells(4, 1) = Co3 - Co2
Cells(5, 1) = Co4 - Co3
Cells(6, 1) = Co5 - Co4
Cells(7, 1) = Co6 - Co5
Cells(8, 1) = Co7 - Co6
Cells(9, 1) = Co8 - Co7
Cells(10, 1) = Co9 - Co8
Cells(11, 1) = Co10 - Co9
Cells(12, 1) = Co11

Cells(2, 1) = "0～0.999"
Cells(3, 1) = "1～1.999"
Cells(4, 1) = "2～2.999"
Cells(5, 1) = "3～3.999"
Cells(6, 1) = "4～4.999"
Cells(7, 1) = "5～5.999"
Cells(8, 1) = "6～6.999"
Cells(9, 1) = "7～7.999"
Cells(10, 1) = "8～8.999"
Cells(11, 1) = "9～9.999"
Cells(12, 1) = "10～"

これを短くする方法を教えてください。

No.1 回答者： tom04 回答日時： 2014/06/27 08:58

こんにちは！

一例です。

仮にCOUNTする範囲を　G1～G30　とした場合のコードです。

Sub Sample1()
Dim k As Long, myRng As Range, myArry
myArry = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Set myRng = Range(Cells(1, "G"), Cells(30, "G")) '←★ここで範囲指定
For k = 0 To UBound(myArry)
With Cells(k + 2, "A")
.Value = k & "～" & k + 0.999
.Offset(, 1) = WorksheetFunction.CountIf(myRng, "<" & myArry(k)) _
- WorksheetFunction.Sum(Range(Cells(1, "B"), Cells(k + 1, "B")))
End With
Next k
With Cells(12, "A")
.Value = "10～"
.Offset(, 1) = WorksheetFunction.CountIf(myRng, ">=" & 10)
End With
End Sub

こんな感じでは同でしょうか？m(_ _)m

No.2 回答者： 30246kiku 回答日時： 2014/06/27 10:49

> Cells(2, 1) = "0～0.999"

ここから始まる部分だけで良いかも
※せっかく求めた列に上書きしているようなので

という事は置いといて

求めたのがA列、上記がB列として
CountIf を使わないで、ベタに処理する例になれたら・・・

※ 範囲指定したセル全部判別するので、
　　範囲が大きければそれなりに遅くなると思います。
※ セル結合がないもので動くとは思います


Public Sub Samp1()
　　Dim i As Long, j As Long

　　With Range("A2:B12")
　　　　.ClearContents
　　　　With .Columns(2)
　　　　　　.Formula = "=ROW()-2&""～""&ROW()-2&"".999"""
　　　　　　.Value = .Value
　　　　End With
　　　　.Cells(.Count).Value = "10～"
　　End With

　　With Range(Cells(○, ○), Cells(○, ○))
　　　　For i = 1 To .Count
　　　　　　If (Not IsEmpty(.Cells(i).Value)) Then
　　　　　　　　On Error Resume Next
　　　　　　　　j = Int(.Cells(i).Value)
　　　　　　　　If (Err = 0) Then
　　　　　　　　　　If (j < 0) Then
　　　　　　　　　　　　j = 0
　　　　　　　　　　ElseIf (j > 10) Then
　　　　　　　　　　　　j = 10
　　　　　　　　　　End If
　　　　　　　　　　Cells(j + 2, "A").Value = Cells(j + 2, "A").Value + 1
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End With
End Sub

とか

Public Sub Samp2()
　　Dim rng As Range
　　Dim iSum As Long, i As Long

　　Set rng = Range(Cells(○, ○), Cells(○, ○))
　　With Range("A2:B12")
　　　　.ClearContents
　　　　With .Columns(2)
　　　　　　.Formula = "=ROW()-2&""～""&ROW()-2&"".999"""
　　　　　　.Value = .Value
　　　　End With
　　　　.Cells(.Count).Value = "10～"

　　　　iSum = 0
　　　　For i = 1 To 10
　　　　　　With .Cells(i, 1)
　　　　　　　　.Value = WorksheetFunction.CountIf(rng, "<" & i) - iSum
　　　　　　　　iSum = iSum + .Value
　　　　　　End With
　　　　Next
　　　　.Cells(i, 1).Value = WorksheetFunction.CountIf(rng, ">=10")
　　End With
　　Set rng = Nothing
End Sub

No.3 回答者： okormazd 回答日時： 2014/06/27 21:38

次のようなことをやりたいのかな。

Sub test()

Dim cnt(11) As Integer, i As Integer, rng As Range
Set rng = Range(Cells(〇, 〇), Cells(〇, 〇))
For i = 1 To 10
cnt(i) = WorksheetFunction.CountIf(rng, "<" & i)
Next
cnt(i) = WorksheetFunction.CountIf(rng, ">=10")
For i = 1 To 10
Cells(i + 1, 1) = i - 1 & "～" & i - 0.001
Cells(i + 1, 2) = cnt(i) - cnt(i - 1)
Next
Cells(i, 1) = i - 1 & "～"
Cells(i, 2) = cnt(i)

End Sub

なお、同じ結果を得るなら、「分析ツール」―「ヒストグラム」でもできるし、これをVBAで使えば短くなる。

Sub test2
Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("〇:〇"), _
ActiveSheet.Range("□"), ActiveSheet.Range("△:△"), False, False _
, False, False
End Sub

これだけ。

"〇:〇"　データ範囲
"□"　　　出力先
"△:△"　データ区間のセル範囲

No.4 回答者： hallo-2007 回答日時： 2014/06/28 11:33

一案ですが

ご希望の集計ができる基本シートを準備して
関数を配置しておく。

ＶＢＡのボタンをおすと
別のシート（或いは　新規のシート）へ
値の貼り付けで固定してしまう。

ＶＢＡのコードはわずかになりますし
将来、シートの変更が発生した場合も
コードを修正することなく、基本シートを変更すれば
いくらでも見栄えの良いシートになり便利かと思います。

No.5 回答者： Gattyonn 回答日時： 2014/06/28 23:52

Option Explicit

Sub Goose()
Dim Co(0 To 10)
Dim Poo As Integer
Dim Boo As Integer
'データ範囲（例えばE列）
Poo = 5
Co(0) = 0
For Boo = 0 To 9
Co(Boo + 1) = WorksheetFunction.CountIf(Columns(Poo), "<" & (Boo + 1))
Cells(Boo + 2, "B").Value = Co(Boo + 1) - Co(Boo)
Cells(Boo + 2, "A").Value = Boo & "～" & Boo & ".999"
Next
Cells(12, "B").Value = WorksheetFunction.CountIf(Columns(Poo), ">=10")
Cells(12, "A").Value = "10～"
MsgBox ("Gattyonn!!")
End Sub