LoginSignup
31
37

More than 5 years have passed since last update.

VBAでコールバック関数を使ういろんな方法

Last updated at Posted at 2017-01-03

ここでやりたいこと

何か数値を保持するクラスNumValueがあって、そのApplyCalcメソッドに実際に計算を行う関数DoCalcを渡したいとします。

NumValue(クラスモジュール)
Option Explicit

Public Num As Long

Public Function ApplyCalc() As Long
    ' ここでコールバック関数を呼び出す
End Function
標準モジュール
Option Explicit

Public Sub test()
    Dim cNumValue As NumValue
    Set cNumValue = New NumValue

    cNumValue.Num = 5  ' 値 5を保持
    Debug.Print cNumValue.ApplyCalc()  ' ここで関数を渡したい
End Sub

' 実際に計算を行う関数
Public Function DoCalc(x As Long) As Long
    DoCalc = x * 2 + 1
End Function

Application.Run

 Application.Runに関数名と引数を渡すと呼び出せます。外部のVBAプログラムを呼び出すときにおなじみの方法ですね。たぶん、いちばんお手軽な方法です。

NumValue(クラスモジュール)
Public Function ApplyCalc(funcName As String) As Long
    ApplyCalc = Application.Run(funcName, Num)
End Function
標準モジュール
Debug.Print cNumValue.ApplyCalc("DoCalc")  ' => 11

クラスメソッドとして呼び出す

こちらのページ http://qiita.com/rai_suta/items/c07b22130b302682b729 の内容です。
ここではCallbackクラスをつくって、その中のメソッドとして呼び出しています。
メソッド名を文字列で書かなくて済むのはすっきりしますが、いちいちクラスを作るのが面倒でもあります。

CallBack(クラスモジュール)
Option Explicit

' 実際に計算を行う関数
Public Function DoCalc(x As Long) As Long
    DoCalc = x * 2 + 1
End Function
NumValue(クラスモジュール)
Public Function ApplyCalc(callbackObj As CallBack) As Long
    ApplyCalc = callbackObj.DoCalc(Num)
End Function
標準モジュール
Debug.Print cNumValue.ApplyCalc(New CallBack)   ' => 11

インターフェースをつかって型安全に呼び出す

前述のページ http://qiita.com/rai_suta/items/c07b22130b302682b729 で詳しく解説されていますので、そちらをどうぞ。
手間はかかりますが、これがVBAの言語仕様の中で一番スマートな気がします。

クラスメソッド + CallByName

これも前述のページの内容です。メソッド名を呼び出す側で指定できます。

NumValue(クラスモジュール)
Public Function ApplyCalc(callbackObj As CallBack, funcName As String) As Long
    ApplyCalc = CallByName(callbackObj, funcName, VbMethod, Num)
End Function
標準モジュール
Debug.Print cNumValue.ApplyCalc(New CallBack, "DoCalc")   ' => 11

CallByNameでWorksheetオブジェクトの関数を呼び出す

自分でクラスを作る代わりに、Worksheetオブジェクトに関数を追加します。UserFormに書いてもOKです。

多少手間は減りますが、関係のないWorksheetの中に処理を書くのが変な感じです。

Sheet1(Worksheetオブジェクト)
Option Explicit

' 実際に計算を行う関数
Public Function DoCalc(x As Long) As Long
    DoCalc = x * 2 + 1
End Function
NumValue(クラスモジュール)
Public Function ApplyCalc(callbackObj As Worksheet, funcName As String) As Long
    ApplyCalc = CallByName(callbackObj, funcName, VbMethod, Num)
End Function

標準モジュール
Debug.Print cNumValue.ApplyCalc(Sheet1, "DoCalc")

もっとラムダ式みたいに簡潔に書きたい!

LINQのようなのを作りたいと思った時に、処理をいちいち別の場所に書きたくないですよね。
かなり邪道ですが、方法はあるにはあります。

Reflection的なやりかた

VBEをいじって動的に関数を追加します。
↓このページが元ネタです。http://codereview.stackexchange.com/questions/66593/generating-and-calling-code-on-the-fly

準備

まず、VBEの参照設定でMicrosoft Visual Basic for Applications Extensibilityへの参照を追加します。

更に、Excelのオプション>セキュリティセンター>マクロの設定で「VBAプロジェクト オブジェクトモデルへのアクセスを信頼する」にチェックを入れます。

それから、関数を一時的に作る場所になるAnonymousCodeという標準モジュールを追加します。

コード

NumValue(クラスモジュール)
Option Explicit

Public Num As Long

Public Function ApplyCalc(processingCode As String) As Long
    Call GenerateAnonymousMethod(processingCode)

    ApplyCalc = Application.Run("AnonymousCode.DoCalc", Num)

    Call DestroyAnonymousMethod
End Function

' 無名関数をつくる
Private Sub GenerateAnonymousMethod(processingCode As String)
    Dim component As VBComponent
    Set component = ThisWorkbook.VBProject.VBComponents("AnonymousCode")

    Dim body As String
    body = "Public Function DoCalc(x As Long) As Long" & vbNewLine & _
           "    DoCalc = " & processingCode & vbNewLine & _
           "End Function"

    component.CodeModule.DeleteLines 1, component.CodeModule.CountOfLines
    component.CodeModule.AddFromString body ' !ここからブレークモードに入れなくなる
End Sub

' 無名関数を削除する
Private Sub DestroyAnonymousMethod()
    Dim component As VBComponent
    Set component = ThisWorkbook.VBProject.VBComponents("AnonymousCode")

    component.CodeModule.DeleteLines 1, component.CodeModule.CountOfLines
End Sub
標準モジュール
Debug.Print cNumValue.ApplyCalc("x * 2 + 1")    ' => 11

注意点など

無名関数の生成・削除の処理を一つ作ってしまえば、簡単に個別の処理を書いて実行できます。
GenerateAnonymousMethodを汎用的につくるなら、VBProjectは名称で指定して、引数も可変長に対応できるようにするなどすればよいでしょう。
しかし、大きな問題点があり、CodeModuleをいじってしまうとその後にブレークモードに入れなくなってしまって、デバッグが困難になります。

ScriptControl

VBScriptの文法になりますが、動的に生成したコードを実行できます。

NumValue(クラスモジュール)
Option Explicit

Public Num As Long
Dim sc As New ScriptControl

Public Function ApplyCalc(expr As String) As Long
    ApplyCalc = Eval(expr, Num)
End Function

Function Eval(expr As String, x As Long) As Long
    Dim code As String

    code = "Function GetResult(x)" & vbCrLf & _
           "    GetResult = " & expr & vbCrLf & _
           "End Function"

    sc.Language = "VBScript"
    sc.AllowUI = True
    sc.AddCode code

    Eval = sc.Run("GetResult", x)
End Function
標準モジュール
Debug.Print cNumValue.ApplyCalc("x * 2 + 1")    ' => 11

注意点

VBScriptでは変数の型を指定できないなど、文法の差異があります。

また、ループで何回もRunを実行しているとScriptContorlのオブジェクトの破棄のタイミングでハングする不具合のようなものがあります。
どうしても使いたいなら、ループを含んだコードを1度だけ実行するなどする必要がありそうです。

Evaluate

単純な数値計算や判定だけであればEvaluate関数でいけます。

NumValue(クラスモジュール)
Public Function ApplyCalc(formula As String) As Long
    ApplyCalc = Evaluate(Replace(formula, "{x}", Num))
End Function
標準モジュール
Debug.Print cNumValue.ApplyCalc("{x} * 2 + 1")    ' => 11

ただし、中身はExcelの数式で書かないといけないのと、引数の渡し方があまりきれいにできないのでそこは注意点です。

補足

後述のとおり、いまひとつ速度が遅いです。
配列定数でEvaluate("{1,2,3,4,5,6}*2+1") ' => [3,5,7,9,11,13]みたいにやりたいところですが、Evaluteに渡せる文字列の長さが256文字までのようです。。
配列を返すPublicな関数を作ってそれをWorksheetのEvaluateから呼び出せば回避はできそうですが、あまりきれいなやり方ではないですね。

速度の比較

5回実行して平均をとりました。

方法 100,000回の処理時間(ms)
Application.Run 1262.6
クラスメソッド(ループ毎にインスタンス生成) 278.2
クラスメソッド(最初にインスタンス生成) 59.2
クラスメソッド+CallByName(ループ毎にインスタンス生成) 578.2
クラスメソッド+CallByName(最初にインスタンス生成) 284.2
Worksheetに関数追加 459.4
Reflection(超遅いので1000回) 2459.6
Script Control ハングするので測れず(たぶん1500くらい)
Evaluate 9190.6

やはり、クラスメソッドの呼び出しが一番早いです。

31
37
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
31
37