| |
▼よっしー さん、皆さん、こんばんは（再々送です）。
>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"のように
>あるセルの数値を足したり引いたりしています。
>ですが、３行目の式のように"+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を実行して下さい。
ということできっちりやるには、すごく大変そうです。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 04/5/17(月) 16:27 -
