Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


67343 / 76738 ←次へ | 前へ→

【13953】Re:先程の関連なのですが・・・
発言  ichinose  - 04/5/17(月) 21:03 -

引用なし
パスワード
   ▼よっしー さん、皆さん、こんばんは(再々送です)。

>strGoukei = Cells(33, 7).FormulaR1C1
>strGoukeiには"=SUM(R[6]C:R[10]C)+R[22]C-R[22]C"
>の様な数式が入っています。
>上記で行っているのは、"=SUM(R[6]C:R[10]C)"が
>基本の数式で、その基本の数式に"+R[22]C"のように
>あるセルの数値を足したり引いたりしています。
>ですが、3行目の式のように"+R[22]C"をして"-R[22]C"
>したらそのまま残ってしまいます。(当たり前の事とは思いますが・・・)
>ではなく、"+R[22]C"をして"-R[22]C"すると、相殺して両方を
>消したいのですが、可能でしょうか?
>よろしくお願い致します。
一番、単純なパターンのロジックでさえ、何度も間違えました。
(まだあるかも・・・・)
基本数式の続きは、セルアドレスの単純な足し算・引き算のみです。


標準モジュールに

'==================================================================
Sub test()
  Dim aaa As String
  Dim a()
  aaa = "=SUM(R[6]C:R[10]C)+R[22]C-R[22]C+R[24]C+R[22]C-R[22]C-R[22]C"
'      解析対象数式

  If 文字列分解(aaa, "=sum\(.+\)", ans1, "(\+|-)r(\[?[0-9]*\]?)c(\[?[0-9]*\]?)", a()) = True Then
'            ↑基本数式の抜き取り(この場合、=sum(・・))
'                        符号付セルアドレスの抜き取り

   Call init_演算 '内部データの初期化
   For idx = LBound(a()) To UBound(a())
     Call put_演算(a(idx)) 'セルアドレスの検索&登録
     Next
   ans = ans1 & ans_演算() '加工後の数式の設定
   Call init_演算
   End If
MsgBox ans
End Sub

'========================================================================
Function 文字列分解(strng, 基本数式, o_基本数式, 正規表現, a_array()) As Boolean
  Dim regEx, Match, Matches  ' 変数を作成します。
  Dim wk
  Set regEx = CreateObject("VBScript.RegExp")
  o_基本数式 = ""
  regEx.Pattern = "^" & 基本数式
  regEx.IgnoreCase = True  ' 大文字と小文字を区別しないように設定します。
  regEx.Global = True  ' 文字列全体を検索するように設定します。
  Set Matches = regEx.Execute(strng)  ' 検索を実行します。
  If Matches.Count = 1 Then
   o_基本数式 = Matches(0).Value
   wk = Replace(strng, o_基本数式, "")
  Else
   wk = strng
   End If
  regEx.Pattern = 正規表現
  regEx.IgnoreCase = True  ' 大文字と小文字を区別しないように設定します。
  regEx.Global = True  ' 文字列全体を検索するように設定します。
  Set Matches = regEx.Execute(wk)  ' 検索を実行します。
  idx = 1
  For Each Match In Matches  ' Matches コレクションに対して繰り返し処理を行います。
   ReDim Preserve a_array(1 To idx)
   a_array(idx) = Match.Value
   idx = idx + 1
  Next
  Set regEx = Nothing
  Set Match = Nothing
  Set Matches = Nothing
  If idx > 1 Then
   文字列分解 = True
  Else
   文字列分解 = False
   End If
End Function

別の標準モジュールに
'====================================================================
Private data_array()
Private dcnt_array() As Long
Private d_idx As Long
'=====================================================================
Sub init_演算()
  Erase data_array
  Erase dcnt_array
  d_idx = 0
End Sub
'=====================================================================
Sub put_演算(f_data)
  Dim f_wk
  Dim retcode As Long
  retcode = 1
  If d_idx > 0 Then
   For idx = LBound(data_array()) To UBound(data_array())
     If UCase(data_array(idx)) = UCase(Mid(f_data, 2)) Then
      If Mid(f_data, 1, 1) = "+" Then
       dcnt_array(idx) = dcnt_array(idx) + 1
      Else
       dcnt_array(idx) = dcnt_array(idx) - 1
       End If
      retcode = 0
      End If
     Next
   End If
  If retcode = 1 Then
   ReDim Preserve data_array(1 To d_idx + 1)
   data_array(d_idx + 1) = Mid(f_data, 2)
   ReDim Preserve dcnt_array(1 To d_idx + 1)
   If Mid(f_data, 1, 1) = "+" Then
     dcnt_array(d_idx + 1) = 1
   Else
     dcnt_array(d_idx + 1) = -1
     End If
   d_idx = d_idx + 1
   End If
End Sub
'======================================================================
Function ans_演算()
  ans_演算 = ""
  If d_idx > 0 Then
   For idx = LBound(data_array()) To UBound(data_array())
     If dcnt_array(idx) <> 0 Then
      If dcnt_array(idx) > 0 Then
        演算子 = "+"
      Else
        演算子 = "-"
        End If
      For jdx = 1 To Abs(dcnt_array(idx))
        ans_演算 = ans_演算 & 演算子 & data_array(idx)
        Next
      End If
     Next
   End If
End Function

これでプロシジャーtestを実行して下さい。
ということできっちりやるには、すごく大変そうです。
0 hits

【13932】先程の関連なのですが・・・ よっしー 04/5/17(月) 16:03 質問
【13936】Re:先程の関連なのですが・・・ つん 04/5/17(月) 16:27 発言
【13938】Re:先程の関連なのですが・・・ Asaki 04/5/17(月) 16:30 発言
【13942】Re:先程の関連なのですが・・・ よっしー 04/5/17(月) 16:35 質問
【13945】Re:先程の関連なのですが・・・ Jaka 04/5/17(月) 17:25 回答
【13946】Re:先程の関連なのですが・・・ よっしー 04/5/17(月) 17:40 質問
【13972】Re:先程の関連なのですが・・・ Jaka 04/5/18(火) 10:28 発言
【13940】Re:先程の関連なのですが・・・ よっしー 04/5/17(月) 16:33 質問
【13953】Re:先程の関連なのですが・・・ ichinose 04/5/17(月) 21:03 発言
【14007】Re:先程の関連なのですが・・・ よっしー 04/5/18(火) 15:02 お礼

67343 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free