セルの値に応じて数式を入力するシートを変えたい

質問

シート名が
「aaa」
「bbb」
「ccc」
「ddd」
という４つのシートがあります。

シート「aaa」のD4セルに入力した値（シート名）に応じて、
（上記で設定したシート）のF7セルに
"=SUM(F5:F6)"という数式を入力したいのですが、
おわかりの方がいらっしゃいましたらご教授いただければ幸いです。

例）
シート「aaa」のD4セルに「ccc」と入力して実行すると、
シート「ccc」のF7セルに「=SUM(F5:F6)」の数式を入力するマクロを作成したい。

（シート「aaa」のD4セルに「ddd」と入力して実行すると、
同様に、シート「ddd」のF7セルに数式をマクロで入力したい）

回答No.9

SI299792 · ベストアンサー

入力したい式は
=IF(ISBLANK(G47),"",G47*I47)
最初に書いて下さい。

プログラム内に" を書くときは、""にする必要があります。
今回、""なので、""""にします。

４種類用意しました、
実際の数式の違う数式を書くのが嫌なら、Macro3、Macro4の様にして、直接セル上に数式を書くしかありません。
この２つを使う場合、図の様に入力してください。
'
Option Explicit
'
Sub Macro1()
'　 普通にに数式を入れる
　　Range([AAA!D4] & "!F7") = "=IF(ISBLANK(G47)),"""",G47*I47)"
End Sub
'
Sub Macro2()
'　 エラーになった場合、文字列にして強制的に入れる
　　Const Formula = "=IF(ISBLANK(G47)),"""",G47*I47)"
'
　　On Error Resume Next
　　Range([AAA!D4] & "!F7") = "'" & Formula
　　Range([AAA!D4] & "!F7") = Formula
　　On Error GoTo 0
End Sub
'
Sub Macro3()
'　 D4にシート、E4にアドレス、F4に数式を入れて実行
　　Range([AAA!D4] & "!" & [E4]) = [AAA!F4].Formula & ""
End Sub
'
Sub Macro4()
'　 D4にシート、E4にアドレス、F4に数式を入れて実行
'　 エラーになった場合、文字列にして強制的に入れる
　　On Error Resume Next
　　Range([AAA!D4] & "!" & [AAA!E4]).Formula = [AAA!F4].Formula
　　Range([AAA!D4] & "!" & [AAA!E4]).Formula = [AAA!F4].Formula & ""
　　On Error GoTo 0
End Sub

お礼

ご回答ありがとうございます。
「""""」にする事で無事入力できました。
質問の伝え方がわかりづらく申し訳ありませんでした。
ご丁寧な対応に感謝致します。

回答No.8

HohoPapa

埋め込む計算式が変化する
その計算式をE4セルに予め書き込んでおく
という使い方でよければ
以下の関数でいかがでしょうか？

Option Explicit

Private Sub CommandButton1_Click()
　Dim ws As Worksheet, flag As Boolean
　Dim wsName As String

　wsName = Me.Range("D4").Value

　'対象シートがあるかをチェック
　For Each ws In Worksheets
　　If ws.Name = wsName Then flag = True
　Next ws
　If flag = False Then
　　MsgBox wsName & "シートがありません"
　　Exit Sub
　End If

　'計算式をセット
　Sheets(wsName).Range("F7").Formula = Me.Range("E4").Value

End Sub

回答No.7

SI299792

補足をいただきました。
基本的には、エラーにならない限り、どのような式でも入力できます。
ただ、エラーを無視するようにしてあるので、
入らない場合、原因が解らないという欠点があります。
On Error Resume Nextを外せば、エラーで止まるので、原因がわかります。

また、以下のマクロは、エラーになった時、文字列にします。
'
Sub Macro1()
'
　　Const Formula = "=SUM(F5:F6))"
　　Dim Sheet As String
'
　　Sheet = [AAA!D4]
　　On Error GoTo 100
　　Sheets(Sheet).[F7] = Formula
　　On Error GoTo 0
　　End
'
100 '
　　Sheets(Sheet).[F7] = "'" & Formula
　　Resume Next
End Sub

態と間違った式が入れてあります。

補足

ご回答ありがとうございます。

入力したい式は
=IF(ISBLANK(G47),"",G47*I47)
というものなのですが、
どうやら""が動かない原因のようです。

（""を削除すると入力できるのですが
ゼロ値を空白にする必要があるため削除できません）

→　ゼロ値を表示するセルもあるためゼロ値を表示しない設定にはできない

""を削除せずに入力できるでしょうか？

回答No.6

msMike

各シートのセル F7 に次式を入力してみてください。
=IF(aaa!D4=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,9),SUM(F5:F6),"")
【注意】テストする前に必ず[ファイル名を付けて保存]を実行しておくこと

回答No.5

watabe007

>Private Sub Worksheet_Change(ByVal Target As Range)
>の場合どのように実行すれば良いかがわからずにおります。
シートモジュールに貼り付ければ
シート「aaa」のD4セルに「ccc」と入力するとするだけで
シート「ccc」のF7セルに「=SUM(F5:F6)」に記載されます。

回答No.4

SI299792

aaa!D4にシート名が入っていて、そこが指定したシートに数式を入れるのですね。
'
Sub Macro1()
'
　　Dim Sheet As String
'
　　Sheet = [aaa!D4]
　　On Error Resume Next
　　Sheets(Sheet).[F7] = "=SUM(F5:F6)"
　　On Error GoTo 0
End Sub

補足

ご回答ありがとうございます。
=SUM(F5:F6)という式は入力できたのですが、
この他の式は入力できないものなのでしょうか…
今日の夜にもう少し検証してみたいと思います。

回答No.3

山田 太郎（@f_a_007）

【補足】それぞれにってのは・・・

=(aaa!D1="bbb") * SUM(F5:F6)
=(aaa!D1="ccc") * SUM(F5:F6)
=(aaa!D1="ddd") * SUM(F5:F6)

ってことです。

回答No.2

山田 太郎（@f_a_007）

それぞれに

=(aaa!D1="aaa") * SUM(F5:F6)

って式を書いておけばいいような気がするが・・・

回答No.1

watabe007

aaaシートのシートモジュールに以下のコードを貼り付けてください。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sn As String
With Target
If .Address <> "$D$4" Then Exit Sub
If .Value = "" Then Exit Sub
sn = .Value
Select Case sn
Case "bbb", "ccc", "ddd"
Sheets(sn).Range("F7").Formula = "=SUM(F5:F6)"
Case Else
MsgBox "該当するシートが有りません"
End Select
End With
End Sub

補足

ご回答ありがとうございます。
ボタンに登録してクリックして実行したいのですが、
Private Sub Worksheet_Change(ByVal Target As Range)
の場合どのように実行すれば良いかがわからずにおります。
併せて教えていただけるとありがたく存じます。