Last active
April 22, 2020 02:30
-
-
Save furyutei/f7e950e4990f70af67388d7f90cd9acb to your computer and use it in GitHub Desktop.
Excel VBAで関数名を文字列で指定してコールする場合のパフォーマンス調査
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
' 参考:[VBAでコールバック関数を使ういろんな方法 - Qiita](https://qiita.com/Kamo123/items/e676e0cbe6de83410980) | |
Function Func(x As Long) As Double | |
Func = Rnd * x | |
End Function | |
Function Wrapper(x As Long) As Double | |
Wrapper = WrapperFunc(x) | |
End Function | |
Sub Benchmark() | |
Dim T As Double | |
Dim i As Long | |
Dim TryNumber As Long: TryNumber = 1000000 | |
Dim o As Class1: Set o = New Class1 | |
T = Timer | |
For i = 1 To TryNumber | |
Call Func(i) | |
Next | |
Debug.Print "Direct call of Func(): " & Format(Timer - T, "0.0000") & " sec" | |
T = Timer | |
For i = 1 To TryNumber | |
Call o.Func(i) | |
Next | |
Debug.Print "Direct call of o.Func(): " & Format(Timer - T, "0.0000") & " sec" | |
T = Timer | |
For i = 1 To TryNumber | |
Application.Run "Func", i | |
Next | |
Debug.Print "Application.Run Func(): " & Format(Timer - T, "0.0000") & " sec" | |
T = Timer | |
For i = 1 To TryNumber | |
CallByName o, "Func", VbMethod, i | |
Next | |
Debug.Print "Use CallByName o.Func(): " & Format(Timer - T, "0.0000") & " sec" | |
GenerateWrapperProcedure ProcedureDefinitionLine:="Function WrapperFunc(x As Long) As Double", ProcessingCode:="Func(x)" | |
T = Timer | |
For i = 1 To TryNumber | |
'WrapperFunc i ' コンパイルエラー | |
Wrapper i | |
Next | |
Debug.Print "Use Wrapper: " & Format(Timer - T, "0.0000") & " sec" | |
DestoryWrapperProcedure ProcedureName:="WrapperFunc" | |
End Sub | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
Function Func(x As Long) As Double | |
Func = Rnd * x | |
End Function |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
Sub GenerateWrapperProcedure(ProcedureDefinitionLine As String, ProcessingCode As String, Optional ModuleName As String = "WrapperCode") | |
Dim reg As Object: Set reg = CreateObject("VBScript.RegExp") | |
Dim matches As Variant | |
Dim body As String | |
Dim ProcedureType As String | |
Dim ProcedureName As String | |
With reg | |
.Pattern = "(?:^\s*|\s+)(Sub|Function)\s+([^(\s]+)" | |
.IgnoreCase = False | |
.Global = True | |
Set matches = .Execute(ProcedureDefinitionLine) | |
End With | |
With matches(0) | |
ProcedureType = .Submatches(0) | |
ProcedureName = .Submatches(1) | |
End With | |
body = ProcedureDefinitionLine & vbNewLine & _ | |
IIf(ProcedureType = "Function", ProcedureName & " = ", "Call ") & ProcessingCode & vbNewLine & _ | |
"End " & ProcedureType | |
On Error Resume Next | |
If ThisWorkbook.VBProject.VBComponents(ModuleName) Is Nothing Then | |
If Err.Number <> 0 Then | |
With ThisWorkbook.VBProject.VBComponents.Add(1) | |
.Name = ModuleName | |
End With | |
End If | |
End If | |
On Error GoTo 0 | |
DestoryWrapperProcedure ProcedureName, ModuleName | |
With ThisWorkbook.VBProject.VBComponents(ModuleName) | |
.CodeModule.AddFromString body ' !ここからブレークモードに入れなくなる | |
End With | |
End Sub | |
Sub DestoryWrapperProcedure(ProcedureName As String, Optional ModuleName As String = "WrapperCode") | |
With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule | |
On Error Resume Next | |
.DeleteLines .ProcStartLine(ProcedureName, 0), .ProcCountLines(ProcedureName, 0) | |
On Error GoTo 0 | |
End With | |
End Sub | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
■元ネタ
■ Benchmark() の結果(Excel 2010(32bit)、Windows 10 Pro(64bit)、Interl(R) Core(TM) i7-3820QM@2.70GHz)
Direct call of Func(): 0.2734 sec
Direct call of o.Func(): 0.3438 sec
Application.Run Func(): 24.8203 sec
Use CallByName o.Func(): 4.7266 sec
Use Wrapper: 0.7578 sec