【補足】セル指定を数値に置き換えるマクロについて

質問

Sub macro1()
　Dim h As Range, h1 As Range
　On Error Resume Next
　For Each h In Cells.SpecialCells(xlCellTypeFormulas)
　　h.Formula = Application.ConvertFormula(Formula:=h.Formula, fromreferencestyle:=xlA1, toabsolute:=xlAbsolute)
　　For Each h1 In h.DirectPrecedents.Areas
　　If h1.Count = 1 Then
　　　h.Replace what:=h1.Address(True, True, xlA1), replacement:=Mid(h1.Formula, IIf(Left(h1.Formula, 1) = "=", 2, 1), 999), lookat:=xlPart
　　End If
　　Next
　Next
End Sub

というマクロを使った際のイレギュラーについての質問です。
前回→http://okwave.jp/qa/q7925134.html

まず検証用に再現できる例を提示します。
1．置き換えた後の数値がちょっとおかしい
A1:C10　と　A12:C21
を適当な数字で埋めます（例ではA列は1　B列は2　C列は3で統一しています）
A23:C32
へ
A23には=SUM(A1,A12)　B23には=SUM(B1,B12)　C23には=SUM(C1,C12)
A24には=SUM(A2,A13)　B24には=SUM(B2,B13)　C24には=SUM(C2,C13)
といった具合にセルを引用する関数を並べます
23行目が意図しない結果になると思いますのでご確認ください。
（行数を変えると不具合の発生する位置も変わります）

素人考えですが、
A23の場合
SUMの中の「A1」を変換、「A12」のうちの「A1」の部分だけ変換。
その後二つ目のA1の返り値の後ろに2がついている風に見えます。
でもそれなら、なぜそれ以降も同様にならないのか、が解りません。

2．絶対参照止まり
隣接するセル（A1とB1、A2とA3等）を選択すると発生するようです。
=SUM(A1:B1)ではなく、=SUM(A1,B1)で発生してしまうことが今回の問題点です。

でもA1:B1やもっと広範のA1:C3のような複数セルの範囲指定にも対応出来たら便利ですね
と、この記事を書きながら気づきました。

拙い説明で心苦しいのですが、一緒に考えていただければ幸いです。

回答No.2

mitarashi

横から失礼します。keithin様、いつも勉強させていただいております。

おもしろそうなので、複数セル範囲指定対応させてみました。
検証は不十分ですが、ご参考まで。

Sub test()
Dim h As Range, h1 As Range, targetRange As Range
Dim regEx As Object, Matches As Object
Dim i As Long, j As Long
Dim buf As String

Set regEx = CreateObject("VBScript.RegExp")
With regEx
.MultiLine = False
.IgnoreCase = True
.Global = False '最初の一個だけ
End With
'範囲アドレス表現
regEx.Pattern = "\$[A-Z]+\$[0-9]+:\$[A-Z]+\$[0-9]+"
For Each h In Cells.SpecialCells(xlCellTypeFormulas)
h.Formula = Application.ConvertFormula(Formula:=h.Formula, fromreferencestyle:=xlA1, toabsolute:=xlAbsolute)
Set Matches = regEx.Execute(h.Formula)
Do While Matches.Count > 0
Set targetRange = Range(Matches(0))
buf = "{"
For i = 1 To targetRange.Rows.Count
For j = 1 To targetRange.Rows(i).Cells.Count
If TypeName(targetRange.Rows(i).Cells(j).Value) = "String" Then
'文字列を相手にする関数にも対応するため入れてあります
buf = buf & Chr(34) & CStr(targetRange.Rows(i).Cells(j).Value) & Chr(34) & ","
Else
buf = buf & CStr(targetRange.Rows(i).Cells(j).Value) & ","
End If
Next j
buf = Left(buf, Len(buf) - 1)
If i < targetRange.Rows.Count Then buf = buf + ";"
Next i
buf = buf & "}"
h.Formula = regEx.Replace(h.Formula, buf)
Set Matches = regEx.Execute(h.Formula)
Loop
Next
'単独アドレス表現
regEx.Pattern = "\$[A-Z]+\$[0-9]+"
For Each h In Cells.SpecialCells(xlCellTypeFormulas)
Set Matches = regEx.Execute(h.Formula)
Do While Matches.Count > 0
h.Formula = regEx.Replace(h.Formula, Range(Matches(0).Value).Value)
Set Matches = regEx.Execute(h.Formula)
Loop
Next
End Sub

回答No.1

keithin

Ａ１２のＡ１だけ書き換えてしまうのは、失礼しました。

とりあえずお茶を濁してるだけですが
Sub macro1r1()
　Dim h As Range, h1 As Range
　On Error Resume Next
　For Each h In Cells.SpecialCells(xlCellTypeFormulas)
　　h.Formula = Application.ConvertFormula(Formula:=h.Formula, fromreferencestyle:=xlA1, toabsolute:=xlAbsolute)
　　For Each h1 In h.DirectPrecedents.Areas
　　If h1.Count = 1 Then
　　　h.Replace what:=h1.Address(True, True, xlA1) & ",", replacement:=Mid(h1.Formula, IIf(Left(h1.Formula, 1) = "=", 2, 1), 999) & ",", lookat:=xlPart
　　　h.Replace what:=h1.Address(True, True, xlA1) & ")", replacement:=Mid(h1.Formula, IIf(Left(h1.Formula, 1) = "=", 2, 1), 999) & ")", lookat:=xlPart

　　End If
　　Next
　Next
End Sub

とかで。

隣接するセルの問題は（実はゴメンナサイ、気が付いていたんですが）よく気が付きましたね。簡易版の限界で今のアプローチでは解決できないんで、スルーしてました（爆）。
その応用として「セル範囲」を参照していた時に、いったい全体具体的にどんな具合の結果で表示したいのか考えられていないのが、そもそも今回のご相談で「無理がある」部分です。それに迂闊に例えば「=SUM(A:A)」なんて書かれてた日には、目も当てられません。

＃参考
限定的な条件下で、たとえばSUM関数とかAVERAGE関数とかのようにセルやセル範囲が列記されるだけの関数を１個使ってる式だけしかない、といった状況なら、まぁやりようもあります。

sub macro2()
　dim h as range, h1 as range
　dim s1 as string, s2 as string
　on error resume next
　for each h in selection.specialcells(xlcelltypeformulas)
　　s1 = left(h.formula, instr(h.formula, "(") )
　　s2 = ""
　　for each h1 in h.directprecedents
　　　s2 = s2 & " " & h1.value
　　next
　　s2 = application.trim(s2)
　　s2 = application.substitute(s2, " ", ",")
　　h.formula = s1 & s2 & ")"
　next
end sub

どれも簡易版の範疇を超えていないので、たとえば式中で四則演算を行っているとか、そういったフレキシブルな対応は出来ません。
これ以上高度な事を望むようでしたら、真面目にワードプロセッシングするしかありません。