countif/sumifのようなVBA関数

質問

こんにちは

エクセルVBAで配列aをワークシート関数countifで計算したいのですが、できないようです。代わりになるVBA関数はないでしょうか？もしくは、代替可能な方法はないでしょうか？sumifの代わりもご教示ください！
よろしくお願いします。
---------------
a(0)=1
a(1)=10
a(2)=100

msgbox worksheetfunction.countif(a,">50")
'ここでエラーとなる。

--
エクセル2003

回答No.1

himajin100000

ワークシート関数を再利用せよ、という話で、シートを新たに作ってよければこう・・・

Sub Count1()

Dim newWorksheet As Excel.Worksheet
'やむを得ず暗黙の型変換。なんかCTypeの第二引数に指定出来ず。
'というか、CTypeのヘルプが出ないってことは、VBAにはないのかなぁ
Set newWorksheet = ActiveWorkbook.Worksheets.Add()

Dim a(5) As Integer
Dim i As Integer

a(0) = 7
a(1) = 4
a(2) = 1
a(3) = 5
a(4) = 3
a(5) = 6

For i = 0 To UBound(a)
newWorksheet.Cells(i + 1, 1).Value = a(i)
Next

MsgBox (Excel.WorksheetFunction.CountIf(newWorksheet.Range(newWorksheet.Cells(1, 1), newWorksheet.Cells(UBound(a) + 1, 1)), ">5"))
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(ActiveWorkBook.Worksheets.Count).Delete
Application.DisplayAlerts = True
End Sub

同様にこう。共通する部分は一緒にして省いても良し。

Sub Sum1()

Dim newWorksheet As Excel.Worksheet
'やむを得ず暗黙の型変換。なんかCTypeの第二引数に指定出来ず。
'というか、CTypeのヘルプが出ないってことは、VBAにはないのかなぁ
Set newWorksheet = ActiveWorkbook.Worksheets.Add()

Dim a(5) As Integer
Dim i As Integer

a(0) = 7
a(1) = 4
a(2) = 1
a(3) = 5
a(4) = 3
a(5) = 6

For i = 0 To UBound(a)
newWorksheet.Cells(i + 1, 1).Value = a(i)
Next

MsgBox (Excel.WorksheetFunction.SumIf(newWorksheet.Range(newWorksheet.Cells(1, 1), newWorksheet.Cells(UBound(a) + 1, 1)), ">5"))
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(ActiveWorkBook.Worksheets.Count).Delete
Application.DisplayAlerts = True
End Sub
======================
後はこれらを他のサブルーチンから呼び出せば良い

********************
そういうことをするな、という話であれば自分で作るしかない。
ここからの話は俺の作り方の都合上難度が上昇します。
自信がなくなったら引き返した方が無難。もっと簡単にも作れるんだが、VB.NETに憧れて汎用性を持たせてみたかった。本当はGenericsが欲しかった…。
********************
挿入->クラスモジュール
プロジェクトエクスプローラでこのモジュールを選択した状態で
プロパティウィンドウから
(オブジェクト名)をCollectionUtilに書き換える。
以後いくつかクラスモジュールを追加するので
'各クラスモジュールのオブジェクト名をClass XXXとか書いてあるXXXに書き換えて欲しい

'Class CollectionUtil
Option Explicit

Public Static Function ConvertFromArray(arr() As Integer) As Collection
Dim retval As New Collection
Dim i As Integer
For i = 0 To UBound(arr)
retval.Add (arr(i))
Next
Set ConvertFromArray = retval
End Function

Public Static Sub ConvertToArray(x As Collection, ByRef retval() As Integer)
Dim i As Integer
ReDim retval(x.Count - 1)
For i = 0 To x.Count - 1
retval(i) = x.Item(i + 1)
Next
End Sub

Public Static Function FindAll(c As Collection, f As IFilter) As Collection
Dim retval As Collection
Dim i As Integer
Set retval = New Collection
For i = 1 To c.Count
If f.isMatch(c.Item(i)) Then
retval.Add (c.Item(i))
End If
Next
Set FindAll = retval
End Function

Public Static Function Sum(c As Collection) As Integer
Dim retval As Integer
Dim i As Integer
For i = 1 To c.Count
retval = retval + CInt(c.Item(i))
Next
Sum = retval
End Function
===========

'Class IFilter
Option Explicit

Public Function isMatch(x As Integer) As Boolean
isMatch = True
End Function

=============
'Class MyLargerFilter
Option Explicit
Implements IFilter

Private threshold As Integer

Public Sub Class_initialize()
End Sub

Public Sub SetThreshold(x As Integer)
threshold = x
End Sub

Public Function IFilter_isMatch(x As Integer) As Boolean
If CInt(x) > threshold Then
IFilter_isMatch = True
Else
IFilter_isMatch = False
End If
End Function

==============
標準モジュールに戻って・・・例によって共通部分は単独で出来るように一応書いただけで省いても構わない

Sub Sum2()

Dim a(5) As Integer
Dim b() As Integer

Dim source As Collection
Dim destination As Collection

Dim Filter As MyLargerFilter

Dim CollectionUtil1 As New CollectionUtil

a(0) = 7
a(1) = 4
a(2) = 1
a(3) = 5
a(4) = 3
a(5) = 6

Set Filter = New MyLargerFilter
Filter.SetThreshold (5)

Set source = CollectionUtil1.ConvertFromArray(a)
Set destination = CollectionUtil1.FindAll(source, Filter)

MsgBox (CollectionUtil1.Sum(destination))

End Sub

Sub Count2()

Dim a(5) As Integer
Dim b() As Integer

Dim source As Collection
Dim destination As Collection

Dim Filter As MyLargerFilter

Dim CollectionUtil1 As New CollectionUtil

a(0) = 7
a(1) = 4
a(2) = 1
a(3) = 5
a(4) = 3
a(5) = 6

Set Filter = New MyLargerFilter
Filter.SetThreshold (5)

Set source = CollectionUtil1.ConvertFromArray(a)

Set destination = CollectionUtil1.FindAll(source, Filter)

CollectionUtil1.ConvertToArray destination, b

MsgBox (UBound(b) + 1)

End Sub

あとはその二つを
標準モジュールの

Sub Main()

Call Count2
Call Sum2

End Sub

ってところから呼び出してみる。

結果→2 13

お礼

ありがとうございます。