• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:セルの値に応じて数式を入力するシートを変えたい)

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

このQ&Aのポイント
  • シート名に応じて数式を入力するマクロを作成したい
  • シート「aaa」のD4セルに入力した値に応じて、上記で設定したシートのF7セルに数式を入力したい
  • シート「aaa」のD4セルに「ccc」と入力して実行すると、シート「ccc」のF7セルに「=SUM(F5:F6)」の数式を入力するマクロを作成したい

質問者が選んだベストアンサー

  • ベストアンサー
  • SI299792
  • ベストアンサー率47% (774/1620)
回答No.9

入力したい式は =IF(ISBLANK(G47),"",G47*I47) 最初に書いて下さい。 プログラム内に" を書くときは、""にする必要があります。 今回、""なので、""""にします。 4種類用意しました、 実際の数式の違う数式を書くのが嫌なら、Macro3、Macro4の様にして、直接セル上に数式を書くしかありません。 この2つを使う場合、図の様に入力してください。 ' 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

rabbit78
質問者

お礼

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

その他の回答 (8)

  • HohoPapa
  • ベストアンサー率65% (455/693)
回答No.8

埋め込む計算式が変化する その計算式を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

  • SI299792
  • ベストアンサー率47% (774/1620)
回答No.7

補足をいただきました。 基本的には、エラーにならない限り、どのような式でも入力できます。 ただ、エラーを無視するようにしてあるので、 入らない場合、原因が解らないという欠点があります。 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 態と間違った式が入れてあります。

rabbit78
質問者

補足

ご回答ありがとうございます。 入力したい式は =IF(ISBLANK(G47),"",G47*I47) というものなのですが、 どうやら""が動かない原因のようです。 (""を削除すると入力できるのですが ゼロ値を空白にする必要があるため削除できません) → ゼロ値を表示するセルもあるためゼロ値を表示しない設定にはできない ""を削除せずに入力できるでしょうか?

  • msMike
  • ベストアンサー率20% (364/1804)
回答No.6

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

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.5

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

  • SI299792
  • ベストアンサー率47% (774/1620)
回答No.4

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

rabbit78
質問者

補足

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

回答No.3

【補足】それぞれにってのは・・・ =(aaa!D1="bbb") * SUM(F5:F6) =(aaa!D1="ccc") * SUM(F5:F6) =(aaa!D1="ddd") * SUM(F5:F6) ってことです。

回答No.2

それぞれに =(aaa!D1="aaa") * SUM(F5:F6) って式を書いておけばいいような気がするが・・・

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

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

rabbit78
質問者

補足

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

関連するQ&A

専門家に質問してみよう