countif/sumifのようなVBA関数

質問

こんにちは

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

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

--
エクセル2003

回答No.5

Wendy02 · ベストアンサー

こんにちは。

もう一度、関数表から調べて作り直してみました。

>1000要素の配列が10万個くらいあるのです。

実際、元の質問のように、個別にデータを配列変数に入れる方法なら、ループで、変数に入れる時に数えればよいわけです。本当の問題は、配列にする前のデータです。これは、「最初に配列ありき」で始まっているから、難しいのだと思います。

そういう条件は、本来、配列構造を持ったものを、そのまま配列変数に代入するという方法が確立しているという条件が隠されているように思います。今、.Net FrameWork の ArrayList を試してみましたが、.Add で入れるなら、何もならないし、AddRange で入れるには、本来、そうした同じ、ArrayList の配列構造（というよりも、Collection)を持っていることが条件ですから、上手く行きませんでした。

これは、ワークシートのRange を前回の同じように、一列を切り出す方法です。
'Ar = Application.Index(Range("A1:A10000").Value, 0, 1)

以下のコードを見てください。VBA独特のコードです。

Excelのバージョンに依存するはすですが、Frequency 関数が使えます。ストレスなく、CountIf と同じように数を出すことができました。なお、今回は、WorksheetFunction から関数を取り出すことにしました。

Delta = Array(50, iMax)　51かと思いましたが、50と入れて、51以上になるようです。

'-------------------------------------------
Sub SampleTest2()
　　Dim Delta As Variant
　　Dim iMax As Long
　　Dim Ar As Variant
　　Dim Ret As Variant
　　Dim i As Long
　　Ar = Array(19, 9, 97, 100, 61, 59, 88, 29, 42, 39)
　　'Ar = Application.Index(Range("A1:A10000").Value, 0, 1)
　　iMax = WorksheetFunction.Max(Ar)
　　Delta = Array(50, iMax)
　　Ret = WorksheetFunction.Frequency(Ar, Delta)
　　i = Ret(2, 1)
　　MsgBox i

End Sub

お礼

こういう方法もあるのですね。
一度試してみます。

いろいろと試すことがあるため、御礼まで少々お時間いただきます。

回答No.4

tom11

http://oshiete1.goo.ne.jp/qa5608083.html

これを質問した人なのですね。

＞10億回くらい計算しないといけなくなるので

もしかして、データ数が、10億個あるのですか

多分、そもそも、配列のd(1000000000)の宣言が出来ないような
気がします。

お礼

できないことはしません。

回答No.3

Wendy02

こんにちは。

こういうのは、餅屋は餅屋なのですが、参りましたね。

今回のご質問に、前提が書かれていないようでしたが、本来の目的は、その計算処理スピードを上げたいということだったように思います。

それはなかなか難しいですね。ワークシート上で処理したほうが速い気がします。

なお、ワークシート関数は、仕様が明らかにはなっていませんが、配列を引数としてできるものとそうでないものがありますが、今回は、どうも上手くいきません。

とりあえず、数百万というデータ数に対するものとすると、今回の回答は、100点満点で、50点から60点の間です。一応、途中まで読んで、それで数を決めています。これでは、配列をワークシートに貼りつけて、ワークシート関数で計算したほうがはるかに上です。ただし、貼り付ける場合は、ループで張り付けずに、配列のまま貼りつけます。ADOに切り替えても、Excelの場合は、アーリーバインディングにしても、そのオブジェクトを生成する時の、オーバーヘッドが掛かってしまうので、期待した効果がありません。

'-------------------------------------------
Sub SampleTest1()
　　Dim Ar As Variant
　　Dim ret As Long
　　Ar = Array(19, 9, 97, 100, 61, 59, 88, 29, 42, 39)
　　ret = ArrayCountIf(Ar, 50)
　　MsgBox ret
End Sub

Function ArrayCountIf(BaseArray As Variant, arg As Long)
　　Dim ret As Long
　　Dim i As Long, j As Long
　　Dim Mn As Long
　　Dim Mx As Long
　　Mn = LBound(BaseArray)
　　Mx = UBound(BaseArray)
　　j = Mx - Mn + 1
　　With Application
　　　　For i = 1 To j
　　　　　　ret = .Small(BaseArray, i)
　　　　　　If ret > arg Then Exit For '以上
　　　　Next
　　End With
　　ArrayCountIf = j - i + 1
End Function

'-------------------------------------------

お礼

1000要素の配列が10万個くらいあるのです。
ワークシートに貼り付けたほうが早いのかもしれませんね。
どうもありがとうございます。

回答No.2

tom11

>エクセルVBAで配列aをワークシート関数countifで計算したいのですが、
>できないようです。代わりになるVBA関数はないでしょうか？

代わりになる関数は、解りませんが、自分で作っても
簡単だと思いますよ

>もしくは、代替可能な方法はないでしょうか？

配列をワークシートに展開して、

WorksheetFunction.CountIf

を使ったらいかがですか？？

ワークシートに展開すればSumIfも同様です。

お礼

自分で作ってみたら、遅かったです。。
ワークシートへの展開もやってみます。
ありがとうございます。

回答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

お礼

ありがとうございます。