countif/sumifのようなVBA関数

Question

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

Wendy02 · Accepted Answer

こんにちは。

もう一度、関数表から調べて作り直してみました。

>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

tom11 · Answer

http://oshiete1.goo.ne.jp/qa5608083.html

これを質問した人なのですね。

＞10億回くらい計算しないといけなくなるので

もしかして、データ数が、10億個あるのですか

多分、そもそも、配列のd(1000000000)の宣言が出来ないような
気がします。

Wendy02 · Answer

こんにちは。

こういうのは、餅屋は餅屋なのですが、参りましたね。

今回のご質問に、前提が書かれていないようでしたが、本来の目的は、その計算処理スピードを上げたいということだったように思います。

それはなかなか難しいですね。ワークシート上で処理したほうが速い気がします。

なお、ワークシート関数は、仕様が明らかにはなっていませんが、配列を引数としてできるものとそうでないものがありますが、今回は、どうも上手くいきません。

とりあえず、数百万というデータ数に対するものとすると、今回の回答は、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

'-------------------------------------------

tom11 · Answer

>エクセルVBAで配列aをワークシート関数countifで計算したいのですが、
>できないようです。代わりになるVBA関数はないでしょうか？

代わりになる関数は、解りませんが、自分で作っても
簡単だと思いますよ

>もしくは、代替可能な方法はないでしょうか？

配列をワークシートに展開して、

WorksheetFunction.CountIf

を使ったらいかがですか？？

ワークシートに展開すればSumIfも同様です。

himajin100000 · Answer

ワークシート関数を再利用せよ、という話で、シートを新たに作ってよければこう・・・

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

countif/sumifのようなVBA関数

こんにちは。

こんにちは。

>エクセルVBAで配列aをワークシート関数countifで計算したいのですが、

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

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング