CnvFormula 絶対参照にsheet名を付けたい

質問

winxp he sp3, excel2003
CnvFormula　範囲指定して相対→絶対参照に変換します。
sheet1→sheet2にcopyした時、sheet名が必要です。
下記マクロにsheet名を追加したいのです。

Sub CnvFormula()
With Selection.SpecialCells(xlCellTypeFormulas)
.Formula = Application.ConvertFormula(.Formula, xlA1, xlA1, xlAbsolute)
End With
End Sub

よろしくお願いします。

回答No.7

KenKen_SP · ベストアンサー

#3 です。

> debug 結果です。シート名が付いていませんでした。

当方でのテストデータはうまくいってましたが、

　　r.DirectPrecedents.Areas

では、期待するセルブロックに分割してくれなかったのが原因のよう
ですね。この対策として

　　r.DirectPrecedents.Cells

に変更し、さらに Sum(A1:C10) のようなパターンにも対応できるよう、
バグフィックスしました。あまりスマートではありませんが。

Sub CnvFormula2()

　　If Not TypeOf Selection Is Range Then Exit Sub

　　Dim rHasFormula As Range
　　Set rHasFormula = Selection.SpecialCells(xlCellTypeFormulas)
　　If rHasFormula Is Nothing Then
　　　　MsgBox "数式セルは無い", vbInformation
　　　　Exit Sub
　　End If

　　Dim r　　　　As Range
　　Dim rr　　　 As Range
　　Dim iPos　　 As Long

　　Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual

　　On Error GoTo Err_

　　For Each r In rHasFormula.Cells
　　　　' // 絶対参照式へ置換
　　　　r.Formula = Application.ConvertFormula( _
　　　　　　　　　　r.Formula, xlA1, xlA1, xlAbsolute)
　　　　' // 外部参照式へ置換
　　　　For Each rr In r.DirectPrecedents.Cells
　　　　　　iPos = InStr(r.Formula, rr.Address)
　　　　　　If iPos > 0 Then
　　　　　　　　If Mid$(r.Formula, iPos - 1, 1) <> ":" Then
　　　　　　　　　　r.Formula = Replace$(r.Formula, _
　　　　　　　　　　　　　　　　　　　　 rr.Address, _
　　　　　　　　　　　　　　　　　　　　 rr.Address(External:=True))
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　Next

Bye_:
　　Application.Calculation = xlCalculationAutomatic
　　Exit Sub
Err_:
　　MsgBox Err.Description, vbInformation
　　Resume Bye_
End Sub

お礼

私の希望通りできました。ありがとう御座いました。

回答No.6

xls88

ANo.4で提示したコードで、曲がりなりにもシート名が付けられると思います。
あとは、このコードを esd827 さんの環境に合わせて書き直しすれば良いのではないでしょうか。
それが出来ないのなら、架空の数式、架空のシート名ではなく、実際の数式、実際のシート名と、現状のマクロを現状のまま提示してみてください。

お礼

ANo.7さんの回答で、私の希望通りできました。ありがとう御座いました。

回答No.5

xls88

>・シート名に汎用性がありません。下記はsheet1 sheet2 に変更しています。
>・N→Q列になっています。
>シート名：データ sheet1
>f22～f25　　　実際にはF列です
>=N22-(N22-O22)*0.618
>=N23-(N23-O23)*0.618
>=N24-(N24-O24)*0.618
>=N25-(N25-O25)*0.618
>
>シート名：重点 sheet2
>c6～c9　実際にはC列です
>=Sheet1!Q22-(Sheet1!Q22-Sheet1!R22)*0.618
>=Sheet1!Q23-(Sheet1!Q23-Sheet1!R23)*0.618
>=Sheet1!Q24-(Sheet1!Q24-Sheet1!R24)*0.618
>=Sheet1!Q25-(Sheet1!Q25-Sheet1!R25)*0.618

何がいけないのか理解できません。
”・シート名に汎用性がありません。”とはどういう意味合いなのでしょうか。
シート名：重点 sheet2 の数式にはシート名が付加されていますが、これでは駄目なのですか。
提案したマクロは、あくまでサンプルです。esd827さんの環境に合わせて、シート名を書き直すとかしなければなりません。
ひとつ気になるのは、シート名：重点 sheet2 の数式に＄マークが付いていないのですが、何故ですか？
＄マークなしでコピーするとセル番地が相対的に変化します。

補足

すみません　下記のように訂正させて頂きます。
・絶対番地はokです。
・使い勝手を良くする為、シート名を自動的に付けたいのです。難しいでしょうか。
sheet1:
=$N$22-($N$22-$O$22)*0.618
=$N$23-($N$23-$O$23)*0.618
=$N$24-($N$24-$O$24)*0.618
=$N$25-($N$25-$O$25)*0.618
sheet2:
=Sheet1!$N$22-(Sheet1!$N$22-Sheet1!$O$22)*0.618
=Sheet1!$N$23-(Sheet1!$N$23-Sheet1!$O$23)*0.618
=Sheet1!$N$24-(Sheet1!$N$24-Sheet1!$O$24)*0.618
=Sheet1!$N$25-(Sheet1!$N$25-Sheet1!$O$25)*0.618

回答No.4

xls88

関数を使わなくても、数式セルの移動で一気に変換出来ました。
一旦、Sheet1の何もないセル位置でコピぺし、Sheet2へカット&コピーします。
そうすれば、Excelが数式にシート名を勝手に付けてくれます。
ただし下記マクロでは、数式セル範囲が不連続の場合にはエラーになります。
数式セル範囲に、複数の離れた範囲が含まれる場合の対応を工夫してみてください。

Sub testCnvFormula()
　　Dim rng As Range
　　Set rng = Selection.SpecialCells(xlCellTypeFormulas)
　　With rng
　　　　.Formula = Application.ConvertFormula(.Formula, xlA1, xlA1, xlAbsolute)
　　End With
　　rng.Copy Worksheets("Sheet1").Range("AA1")
　　Worksheets("Sheet1").Range("AA1").Resize(rng.Rows.Count, rng.Columns.Count).Cut
　　rng.Select
　　ActiveSheet.Paste
End Sub

補足

ありがとう御座います。deback結果です。実際の列でdebackしました。
・シート名に汎用性がありません。下記はsheet1 sheet2 に変更しています。
・N→Q列になっています。
シート名：データ sheet1
f22～f25　　　実際にはF列です
=N22-(N22-O22)*0.618
=N23-(N23-O23)*0.618
=N24-(N24-O24)*0.618
=N25-(N25-O25)*0.618

シート名：重点 sheet2
c6～c9　実際にはC列です
=Sheet1!Q22-(Sheet1!Q22-Sheet1!R22)*0.618
=Sheet1!Q23-(Sheet1!Q23-Sheet1!R23)*0.618
=Sheet1!Q24-(Sheet1!Q24-Sheet1!R24)*0.618
=Sheet1!Q25-(Sheet1!Q25-Sheet1!R25)*0.618

回答No.3

KenKen_SP

こんにちは。

> このマクロを実行しますと、1発で絶対参照になります。

ならないですよ。テストでは上手くいくのでしょうが、実用では定数
セルと数式セルがシート内で混在する場合がほとんどです。従って

　　SpecialCells(xlCellTypeFormulas)

で得られる Range は必ずしも連続範囲とはならないため、ご質問の
ソースで一括処理すると期待しない結果になりますよ。一括で代入する
なら Areas でセルブロック単位に切り分けて処理しないと。

　　Dim r As Range
　　For Each r In Selection.SpecialCells(xlCellTypeFormulas).Areas
　　　　r.Formula = Application.ConvertFormula(r.Formula, _
　　　　　　　　　　xlA1, xlA1, xlAbsolute)
　　Next

でも、これでも少し乱暴ですよね。数式セルをひとつひとつ順次処理
した方が良いですよ。

　　# 下記サンプルソースでは書いてませんが、数式には通常の数式と
　　# 配列数式とありますので、これも切り分けて処理する必要が
　　# あるからです。

で、ご質問に対する回答ですが、キーワードは、

　　DirectPrecedents、
　　Address(External:=True)

ですね。あまり動作検証してませんが、こんな感じ。

Sub CnvFormula()

　　Dim rHasFormula As Range

　　If Not TypeOf Selection Is Range Then Exit Sub

　　' // SpecialCells(xlCellTypeFormulas) は単一セル選択時に実行すると
　　' // シート全体が検索対象となるのに注意
　　Set rHasFormula = Selection.SpecialCells(xlCellTypeFormulas)
　　If rHasFormula Is Nothing Then
　　　　MsgBox "数式セルは無い", vbInformation
　　　　Exit Sub
　　End If

　　Dim r　 As Range
　　Dim rr　As Range

　　Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual

　　On Error GoTo Err_

　　For Each r In rHasFormula.Cells
　　　　' // 絶対参照へ置換
　　　　r.Formula = Application.ConvertFormula( _
　　　　　　　　　　r.Formula, xlA1, xlA1, xlAbsolute)
　　　　' // 外部参照式へ置換
　　　　For Each rr In r.DirectPrecedents.Areas
　　　　　　r.Formula = Replace$(r.Formula, _
　　　　　　　　　　　　　　　　 rr.Address, _
　　　　　　　　　　　　　　　　 rr.Address(External:=True))
　　　　Next
　　Next

Bye_:
　　Application.Calculation = xlCalculationAutomatic
　　Exit Sub
Err_:
　　MsgBox Err.Description, vbInformation
　　Resume Bye_
End Sub

補足

ありがとう御座います。deback結果です。シート名が付いていませんでした。そのため、シート名の汎用性は確認できませんでした。

回答No.2

xls88

>ありがとう御座います。分かりやすく説明します。
>a1-a30範囲指定します。
>このマクロを実行しますと、1発で絶対参照になります。
>この時、数式にsheet1名称を入れたいのです。
>簡単・複雑な数式とは関係なく、sheet名を入れたいのです。
質問の意図は理解できております。
検証するために実際の数式を用いたく、数式の掲載をお願いしたような訳です。

大雑把ですが
Split関数で、数式内のセル番地の部分を取り出し
Replace関数で、シート名＋セル番地に置換すれば良いかなと考えています。
選択範囲内で、各セル毎に処理をすることになると思います。

補足

ありがとう御座います。簡単にするため、下記数式です。
A列 30個
=J1-(J1-K1)*10
=J2-(J2-K2)*10
=J3-(J3-K3)*10
=J4-(J4-K4)*10
=J5-(J5-K5)*10
よろしくお願いします。

回答No.1

xls88

例えば、
=SUM($A$1:$B$1)
といった数式なら

ActiveCell.Formula = Replace(ActiveCell.Formula, "(", "(Sheet1!")

で
=SUM(Sheet1!$A$1:$B$1)
とすることができます。

こんな簡単な数式なら良いのですが、もっと複雑な数式が対象だと思います。
実際の数式を掲載できないでしょうか。検討してみます。

補足

ありがとう御座います。分かりやすく説明します。
a1-a30範囲指定します。このマクロを実行しますと、1発で絶対参照になります。この時、数式にsheet1名称を入れたいのです。簡単・複雑な数式とは関係なく、sheet名を入れたいのです。難しいでしょうか。