【 2016年9月15日  サイト 移転のお知らせ 】
      AddinBox サイトを [ DION ] から [ さくら インターネット ] へ移転しました。  なお、旧サイト は 2017年10月 まで残します。
      この ページ の 移転先 URL  ⇒⇒  http://addinbox.sakura.ne.jp/Excel_Tips18.htm  
 
ロゴ(青) Excel/VBA Tips ロゴ(緑)

Tips18: 【 複素数 演算 】 クラスモジュール

( Update : 2006/7/17 )

  モーグで複素数をクラスモジュールにより処理する質問への回答で参考コードを載せたのですが、
        http://www2.moug.net/bbs/exvba/20060715000007.htm (Internet Archive)
クラスモジュールのサンプル(値と動作を併せ持つオブジェクト)としても良さそうですので、四則演算
と複素数表現との変換処理を含めて実装させてみました。また、比較として「ユーザー定義型」で実
装したものも掲載します。事務系業務には縁の無いジャンルですが例題としてご覧下さい。

正直な話、「ユーザー定義型&関数」を作ってしまった後の感想としては、こちらの方が断然使い易い
ですし、プログラムの面でもクラス化そのものによるメリットは無いですね。

『クラス化する意義があるか?』
『単なる自己満足になっていないか?』
『利用する側から見て、本当に利用し易くなるのか?』
という【必要性を予め検討する】という意味での反面教師として読んでみるのも宜しいかと‥‥


  複素数演算の基本は下記を参考にしました。
    [ Wikipedia / 複素数 ] http://ja.wikipedia.org/wiki/%E8%A4%87%E7%B4%A0%E6%95%B0

※ クラスモジュール 利用 ※

Option Explicit

'=======【 クラスモジュール ( Complex ) 】============
Private dblReal As Double       '実数部
Private dblImag As Double       '虚数部
Private strValue As String      '複素数表示


Private Sub Class_Initialize()
    dblReal = 0
    dblImag = 0
    strValue = "0"
End Sub


Public Property Get Real() As Double
    Real = dblReal
End Property


Public Property Let Real(ByVal CmpReal As Double)
    dblReal = CmpReal
    Call CompStr
End Property


Public Property Get Imag() As Double
    Imag = dblImag
End Property


Public Property Let Imag(ByVal CmpImag As Double)
    dblImag = CmpImag
    Call CompStr
End Property


Public Property Get Value() As String
    Value = strValue
End Property


Public Property Let Value(ByVal CmpValue As String)
    Me.CompSetStr CmpValue
End Property


'<< 加算 >>
Public Function CompSum(ByVal Cmp1 As Complex, ByVal Cmp2 As Complex) As Complex
    dblReal = Cmp1.Real + Cmp2.Real
    dblImag = Cmp1.Imag + Cmp2.Imag
    Call CompStr
    Set CompSum = Me
End Function


'<< 引算 >>
Public Function CompDiff(ByVal Cmp1 As Complex, ByVal Cmp2 As Complex) As Complex
    dblReal = Cmp1.Real - Cmp2.Real
    dblImag = Cmp1.Imag - Cmp2.Imag
    Call CompStr
    Set CompDiff = Me
End Function


'<< 乗算 >>
Public Function CompMult(ByVal Cmp1 As Complex, ByVal Cmp2 As Complex) As Complex
    dblReal = Cmp1.Real * Cmp2.Real - Cmp1.Imag * Cmp2.Imag
    dblImag = Cmp1.Real * Cmp2.Imag + Cmp1.Imag * Cmp2.Real
    Call CompStr
    Set CompMult = Me
End Function


'<< 除算 >>
Public Function CompDiv(ByVal Cmp1 As Complex, ByVal Cmp2 As Complex) As Complex
Dim dblDIV As Double
    If (Cmp2.Value = "0") Then
        dblReal = 0
        dblImag = 0
    Else
        dblDIV = (Cmp2.Real ^ 2) + (Cmp2.Imag ^ 2)
        dblReal = ((Cmp1.Real * Cmp2.Real) _
                    + (Cmp1.Imag * Cmp2.Imag)) / dblDIV
        dblImag = ((Cmp1.Imag * Cmp2.Real) _
                    - (Cmp1.Real * Cmp2.Imag)) / dblDIV
    End If
    Call CompStr
    Set CompDiv = Me
End Function


'<< 共役複素数 >>
Public Function CompCnj(ByVal Cmp1 As Complex) As Complex
    dblReal = Cmp1.Real
    dblImag = (-1) * Cmp1.Imag
    Call CompStr
    Set CompCnj = Me
End Function


'<< 絶対値 >>
Public Function CompAbs(ByVal Cmp1 As Complex) As Complex
    dblReal = Sqr(Cmp1.Real ^ 2 + Cmp1.Imag ^ 2)
    dblImag = 0
    Call CompStr
    Set CompAbs = Me
End Function


'<< 複素数 生成(実数/虚数 指定) >>
Public Function CompSet(ByVal Real As DoubleByVal Imag As DoubleAs Complex
    dblReal = Real
    dblImag = Imag
    Call CompStr
    Set CompSet = Me
End Function


'<< 複素数 生成(複素数 表示) >>
Public Function CompSetStr(ByVal CmpStr As StringAs Complex
Dim i As Integer
Dim cntP As Integer
Dim cntM As Integer
Dim cntI As Integer
Dim strReal As String
Dim strImag As String

    For i = 1 To Len(CmpStr)
        Select Case Mid(CmpStr, i, 1)
          Case "+": cntP = cntP + 1
          Case "-": cntM = cntM + 1
          Case "i": cntI = cntI + 1
          Case "."
          Case "0" To "9"
          Case Else
            cntI = cntI + 2  'Errにする為
        End Select
    Next i

    If (cntP > 2) Or (cntM > 2) Or ((cntP + cntM) > 2) Then
        GoTo Err
    ElseIf (cntI > 1) Or _
           ((cntI = 1) And (Right(CmpStr, 1) <> "i")) Then
        GoTo Err
    ElseIf ((cntP + cntM) = 2) Then
        Select Case Left(CmpStr, 1)
          Case "+", "-"
          Case Else
            GoTo Err
        End Select
    End If

    Select Case (cntP + cntM)
      Case 0
        If (cntI = 0) Then      '正の実数のみ
            strReal = CmpStr
            strImag = ""
        Else                    '正の虚数のみ
            strReal = ""
            strImag = CmpStr
        End If
      Case 1
        If (cntI = 0) Then      '(正)/負の実数のみ
            strReal = CmpStr
            strImag = ""
        Else                    '(正)の実数と正/負の虚数
            i = InStr(CmpStr, "+")
            If (i = 0) Then
                i = InStr(CmpStr, "-")
            End If
            strReal = Left(CmpStr, i - 1)
            strImag = Mid(CmpStr, i)
        End If
      Case 2                    '正/負の実数と正/負の虚数
        i = InStr(2, CmpStr, "+")
        If (i = 0) Then
            i = InStr(2, CmpStr, "-")
        End If
        strReal = Left(CmpStr, i - 1)
        strImag = Mid(CmpStr, i)
    End Select

    dblReal = Val(strReal)
    Select Case strImag
      Case ""
        dblImag = 0
      Case "i", "+i"
        dblImag = 1
      Case "-i"
        dblImag = -1
      Case Else
        strImag = Left(strImag, Len(strImag) - 1)
        dblImag = Val(strImag)
    End Select
    Call CompStr
    Set CompSetStr = Me
    Exit Function
Err:
    dblReal = 0
    dblImag = 0
    Call CompStr
    Set CompSetStr = Me
End Function


'<< 複素数表現(文字列) >>
Private Sub CompStr()
    If (dblReal = 0) And (dblImag = 0) Then
        strValue = "0"
    ElseIf (dblImag = 0) Then
        strValue = CStr(dblReal)
    ElseIf (dblReal = 0) Then
        Select Case dblImag
          Case 1
            strValue = "i"
          Case -1
            strValue = "-i"
          Case Else
            strValue = CStr(dblImag) & "i"
        End Select
    Else
        Select Case dblImag
          Case 1
            strValue = CStr(dblReal) & "+i"
          Case -1
            strValue = CStr(dblReal) & "-i"
          Case Is < 0
            strValue = CStr(dblReal) & CStr(dblImag) & "i"
          Case Else
            strValue = CStr(dblReal) & "+" & CStr(dblImag) & "i"
        End Select
    End If
End Sub


  利用例 は こちら


※ ユーザー定義型 利用 ※

Option Explicit

'=======【 標準モジュール 】============
' ※ 直接[Real, Imag, Value]へ値を代入しない事!
'    変数は初期化し、値の代入は必ず[CompSet, CompSetStr]で行なう事
Public Type Complex
    Real As Double     '実数部
    Imag As Double     '虚数部
    Value As String    '複素数表示
End Type


'<< 初期化 >>
Public Function CompInit() As Complex
Dim CmpWK As Complex
    CmpWK.Real = 0
    CmpWK.Imag = 0
    CmpWK.Value = "0"
    CompInit = CmpWK
End Function


'<< 加算 >>
Public Function CompSum(ByRef Cmp1 As Complex, ByRef Cmp2 As Complex) As Complex
Dim CmpWK As Complex
    CmpWK.Real = Cmp1.Real + Cmp2.Real
    CmpWK.Imag = Cmp1.Imag + Cmp2.Imag
    CmpWK.Value = CompStr(CmpWK)
    CompSum = CmpWK
End Function


'<< 引算 >>
Public Function CompDiff(ByRef Cmp1 As Complex, ByRef Cmp2 As Complex) As Complex
Dim CmpWK As Complex
    CmpWK.Real = Cmp1.Real - Cmp2.Real
    CmpWK.Imag = Cmp1.Imag - Cmp2.Imag
    CmpWK.Value = CompStr(CmpWK)
    CompDiff = CmpWK
End Function


'<< 乗算 >>
Public Function CompMult(ByRef Cmp1 As Complex, ByRef Cmp2 As Complex) As Complex
Dim CmpWK As Complex
    CmpWK.Real = Cmp1.Real * Cmp2.Real - Cmp1.Imag * Cmp2.Imag
    CmpWK.Imag = Cmp1.Real * Cmp2.Imag + Cmp1.Imag * Cmp2.Real
    CmpWK.Value = CompStr(CmpWK)
    CompMult = CmpWK
End Function


'<< 除算 >>
Public Function CompDiv(ByRef Cmp1 As Complex, ByRef Cmp2 As Complex) As Complex
Dim CmpWK As Complex
Dim dblDIV As Double
    If (Cmp2.Real = 0) And (Cmp2.Imag = 0) Then
        '初期化されていない可能性もあるので[Value = "0"]では比較しない
        CmpWK.Real = 0
        CmpWK.Imag = 0
    Else
        dblDIV = (Cmp2.Real ^ 2) + (Cmp2.Imag ^ 2)
        CmpWK.Real = ((Cmp1.Real * Cmp2.Real) _
                    + (Cmp1.Imag * Cmp2.Imag)) / dblDIV
        CmpWK.Imag = ((Cmp1.Imag * Cmp2.Real) _
                    - (Cmp1.Real * Cmp2.Imag)) / dblDIV
    End If
    CmpWK.Value = CompStr(CmpWK)
    CompDiv = CmpWK
End Function


'<< 共役複素数 >>
Public Function CompCnj(ByRef Cmp1 As Complex) As Complex
Dim CmpWK As Complex
    CmpWK.Real = Cmp1.Real
    CmpWK.Imag = (-1) * Cmp1.Imag
    CmpWK.Value = CompStr(CmpWK)
    CompCnj = CmpWK
End Function


'<< 絶対値 >>
Public Function CompAbs(ByRef Cmp1 As Complex) As Complex
Dim CmpWK As Complex
    CmpWK.Real = Sqr(Cmp1.Real ^ 2 + Cmp1.Imag ^ 2)
    CmpWK.Imag = 0
    CmpWK.Value = CompStr(CmpWK)
    CompAbs = CmpWK
End Function


'<< 複素数 生成(実数/虚数 指定) >>
Public Function CompSet(ByVal Real As DoubleByVal Imag As DoubleAs Complex
Dim CmpWK As Complex
    CmpWK.Real = Real
    CmpWK.Imag = Imag
    CmpWK.Value = CompStr(CmpWK)
    CompSet = CmpWK
End Function


'<< 複素数 生成(複素数 表示) >>
Public Function CompSetStr(ByVal CmpStr As StringAs Complex
Dim i As Integer
Dim cntP As Integer
Dim cntM As Integer
Dim cntI As Integer
Dim strReal As String
Dim strImag As String
Dim CmpWK As Complex

    For i = 1 To Len(CmpStr)
        Select Case Mid(CmpStr, i, 1)
          Case "+": cntP = cntP + 1
          Case "-": cntM = cntM + 1
          Case "i": cntI = cntI + 1
          Case "."
          Case "0" To "9"
          Case Else
            cntI = cntI + 2  'Errにする為
        End Select
    Next i

    If (cntP > 2) Or (cntM > 2) Or ((cntP + cntM) > 2) Then
        GoTo Err
    ElseIf (cntI > 1) Or _
           ((cntI = 1) And (Right(CmpStr, 1) <> "i")) Then
        GoTo Err
    ElseIf ((cntP + cntM) = 2) Then
        Select Case Left(CmpStr, 1)
          Case "+", "-"
          Case Else
            GoTo Err
        End Select
    End If

    Select Case (cntP + cntM)
      Case 0
        If (cntI = 0) Then      '正の実数のみ
            strReal = CmpStr
            strImag = ""
        Else                    '正の虚数のみ
            strReal = ""
            strImag = CmpStr
        End If
      Case 1
        If (cntI = 0) Then      '(正)/負の実数のみ
            strReal = CmpStr
            strImag = ""
        Else                    '(正)の実数と正/負の虚数
            i = InStr(CmpStr, "+")
            If (i = 0) Then
                i = InStr(CmpStr, "-")
            End If
            strReal = Left(CmpStr, i - 1)
            strImag = Mid(CmpStr, i)
        End If
      Case 2                    '正/負の実数と正/負の虚数
        i = InStr(2, CmpStr, "+")
        If (i = 0) Then
            i = InStr(2, CmpStr, "-")
        End If
        strReal = Left(CmpStr, i - 1)
        strImag = Mid(CmpStr, i)
    End Select

    CmpWK.Real = Val(strReal)
    Select Case strImag
      Case ""
        CmpWK.Imag = 0
      Case "i", "+i"
        CmpWK.Imag = 1
      Case "-i"
        CmpWK.Imag = -1
      Case Else
        strImag = Left(strImag, Len(strImag) - 1)
        CmpWK.Imag = Val(strImag)
    End Select
    CmpWK.Value = CompStr(CmpWK)
    CompSetStr = CmpWK
    Exit Function
Err:
    CmpWK.Real = 0
    CmpWK.Imag = 0
    CmpWK.Value = CompStr(CmpWK)
    CompSetStr = CmpWK
End Function


'<< 複素数表現(文字列) >>
Private Function CompStr(ByRef Cmp1 As Complex) As String
    If (Cmp1.Real = 0) And (Cmp1.Imag = 0) Then
        CompStr = "0"
    ElseIf (Cmp1.Imag = 0) Then
        CompStr = CStr(Cmp1.Real)
    ElseIf (Cmp1.Real = 0) Then
        Select Case Cmp1.Imag
          Case 1
            CompStr = "i"
          Case -1
            CompStr = "-i"
          Case Else
            CompStr = CStr(Cmp1.Imag) & "i"
        End Select
    Else
        Select Case Cmp1.Imag
          Case 1
            CompStr = CStr(Cmp1.Real) & "+i"
          Case -1
            CompStr = CStr(Cmp1.Real) & "-i"
          Case Is < 0
            CompStr = CStr(Cmp1.Real) & CStr(Cmp1.Imag) & "i"
          Case Else
            CompStr = CStr(Cmp1.Real) & "+" & CStr(Cmp1.Imag) & "i"
        End Select
    End If
End Function


--- 利用例 ---

'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
'_/
'_/   複素数 計算 利用例 ( クラス )
'_/
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

Sub Test1()

  Dim C1 As New Complex
  Dim C2 As New Complex
  Dim C3 As New Complex

' C1=[25+8i] C2=[4-3i]

  C1.CompSet 25, 8
  C2.CompSetStr "4-3i"

' 以下 [ Real / Imag / Value ]は Complex クラスのプロパティ

  MsgBox C1.Real & vbCrLf & C1.Imag & vbCrLf & C1.Value

  C3.Real = 7           '[Value]との同期も常に取られている
  MsgBox C3.Real & vbCrLf & C3.Imag & vbCrLf & C3.Value
  C3.Imag = 2
  MsgBox C3.Real & vbCrLf & C3.Imag & vbCrLf & C3.Value

  C3.Value = "-3+6i"        '[C3.CompSetStr "-3+6i"] と同義
  MsgBox C3.Real & vbCrLf & C3.Imag & vbCrLf & C3.Value

  ' C3=C1+C2
  MsgBox C3.CompSum(C1, C2).Value
  ' C3=C1-C2
  MsgBox C3.CompDiff(C1, C2).Value
  ' C3=C1*C2
  MsgBox C3.CompMult(C1, C2).Value
  ' C3=C1/C2
  MsgBox C3.CompDiv(C1, C2).Value
  ' C3=C1の共役複素数
  MsgBox C3.CompCnj(C1).Value
  ' C3=ABS(C1)
  MsgBox C3.CompAbs(C1).Value

'{C1,C2} の値設定も一緒に行なう例
  ' C3=C1+C2
  MsgBox C3.CompSum(C1.CompSet(25, 8), C2.CompSetStr("4-3i")).Value
  ' C3=C1-C2
  MsgBox C3.CompDiff(C1.CompSet(25, 8), C2.CompSetStr("4-3i")).Value
  ' C3=C1*C2
  MsgBox C3.CompMult(C1.CompSet(25, 8), C2.CompSetStr("4-3i")).Value
  ' C3=C1/C2
  MsgBox C3.CompDiv(C1.CompSet(25, 8), C2.CompSetStr("4-3i")).Value
'- - - - - - - - - - - - - - - - - - - - - - - - - -
End Sub



'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
'_/
'_/   複素数 計算 利用例 ( ユーザー定義型 )
'_/
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

Sub Test2()

  Dim C1 As Complex
  Dim C2 As Complex

  C1 = CompInit
  C2 = CompInit

' C1=[25+8i] C2=[4-3i]
  C1 = CompSet(25, 8)
  C2 = CompSetStr("4-3i")

' 以下 [ Real / Imag / Value ]は Complex 構造体の要素

  MsgBox C1.Real & vbCrLf & C1.Imag & vbCrLf & C1.Value

  ' C1+C2
  MsgBox CompSum(C1, C2).Value
  ' C1-C2
  MsgBox CompDiff(C1, C2).Value
  ' C1*C2
  MsgBox CompMult(C1, C2).Value
  ' C1/C2
  MsgBox CompDiv(C1, C2).Value
  ' C1の共役複素数
  MsgBox CompCnj(C1).Value
  ' ABS(C1)
  MsgBox CompAbs(C1).Value

'{C1,C2} の値設定も一緒に行なう例
  ' C1+C2
  MsgBox CompSum(CompSet(25, 8), CompSetStr("4-3i")).Value
  ' C1-C2
  MsgBox CompDiff(CompSet(25, 8), CompSetStr("4-3i")).Value
  ' C1*C2
  MsgBox CompMult(CompSet(25, 8), CompSetStr("4-3i")).Value
  ' C1/C2
  MsgBox CompDiv(CompSet(25, 8), CompSetStr("4-3i")).Value
'- - - - - - - - - - - - - - - - - - - - - - - - - -
End Sub



 Home   Back Page   Next Page

ロゴ(ゴールド)   ロゴ(ゴールド)

角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2006 Allrights Reserved.