エクセル 計算式

セルのとあるか所に数字を入力したとします。
例えば、Ａ5に「65」、Ａ7に「0.07」と記入しておき、これらの数字にＣ3に入力された数字を乗算して、1,000で除算します。
（計算式は「$A$5*$A$7*C3/1000」ですか？）
さらに、Ｃ3からＣ4、Ｃ5、Ｃ6と横に数字は入力されていき、入力したのちにボタンクリックでその下のセルに計算式の合計を出せるマクロは作れるものでしょうか？

関数を入れればいいんでしょうが、ボタンを押した後、一定の数字以上以下で画像を読み込めるマクロも組み込みたいなと思っていました。
ちょっとした遊び心的な（笑）

質問者からの補足コメント

• すいません、間違えてました；
  横に数字入力されていくのなら、Ｃ3、Ｄ3、Ｅ3…となりますよね；。
  
  よろしくお願いします。

    補足日時：2017/04/26 16:11

• 

  fujillin　様
  回答ありがとうございます。
  書き込まれたとおりの手順でマクロの記憶をやってみましたが、うまくいきません。

    補足日時：2017/04/26 18:51

• WindFaller　様
  
  すごいですね！
  
  早速打ち込んで試してみたのですが、「型が一致しません」と出てしまいました；
  セルの場所が変わる場合、セルの位置を指定する”A５、A7、C３”はすべて書き換えるべきですか？
  
  Range("A5,A7," & DCellName).Borders.ColorIndex = 5
  
  ↑の”５”は変えなくても大丈夫でしょうか？
  
  それとも、ボタンが他にもう一つあるのが原因であるのなら、
  ”Buttons.Count”　を２にすればいいのでしょうか？？

  No.3の回答に寄せられた補足コメントです。 補足日時：2017/04/28 15:33

• マクロ組み立て、大変感謝します。
  
  登録して実行してみたんですが、「型が一致しません」と出た後に希望の結果が出ます。
  そして、右隣以降のセルには結果が出てくれません；；
  どこかこちらで直さなければならない部分はありますか？

  No.6の回答に寄せられた補足コメントです。 補足日時：2017/04/29 11:40

• 

  WindFaller　様
  
  ＜このマクロを既存のシートに入れる場合は、その周りの状況で差し障りのあるものが存在するのではないかと思います。
  
  おっしゃる通り、既存のシートに入れてまして、そのシートには既に「シートジャンプマクロ」と「シート名自動変更マクロ」を入れてます。これが支障をきたしてる原因なのでしょうか…。

  No.7の回答に寄せられた補足コメントです。 補足日時：2017/04/29 19:14

No.8 ベストアンサー 回答者： WindFaller 回答日時： 2017/04/29 20:17

>そのシートには既に「シートジャンプマクロ」と「シート名自動変更マクロ」を入れてます。

これが支障をきたしてる原因なのでしょうか…。

それが問題になっているのか、言葉だけでは分からないです。

レイアウトがどうなっているとか、ワンステップずつ、ステップマクロでどこがエラーがなるかとか、手がかりがなければ、まったく闇の中です。結果がこうなったとか、別のマクロが入っていますと言われましても、内容を見なければ、こちらでは想像が付かないのです。

この回答へのお礼

WindFaller　様
お返事遅くなりました。なかなか難しいものですね。これまで回答くださったものも見返して、少し考えてみたいと思います。また困った時はよろしくお願いします。ｍ(_ _)ｍ

お礼日時：2017/05/02 20:52

No.7 回答者： WindFaller 回答日時： 2017/04/29 17:04

>どこかこちらで直さなければならない部分はありますか？

というよりも、前回から同じことなのですが、

>「型が一致しません」

そのエラーだけを教えてもらっても、まったく解決の目処は立ちません。
前回も同様に、まったく何もない新規シートでお試しくだされば、まったく問題はないはずなのです。

もし、このマクロを既存のシートに入れる場合は、その周りの状況で差し障りのあるものが存在するのではないかと思います。後入れでマクロを入れる場合は、まったく何もない状態でマクロを動かすようにはいかないと思います。
その辺りの詳細を、他人に教えることができないにしても、似た環境を示して、これならどうかと示していただけないと、解答は難しいのです。ただし、それが解決に結びつくとは限りません。

おそらく、こちらの予想にはない使い方だと思います。

次に、どこでエラーが発生しているのか、
ステップマクロ（F8で一つずつ進む）をしてもらわないと分かりません。

もちろん、右隣（C3 -> D3) と進むわけですが、先に計算するための数字が入っていなければ、元の所を再計算するだけです。C4 に数字が入ったら、次は、D3 に先に数字を入れるということをしていないのかもしれません。

No.6 回答者： WindFaller 回答日時： 2017/04/29 01:00

以下のマクロをフォームコントロールのボタンにマクロ登録してください。

実用を考えたボタンです。

'//
Option Explicit

'設定（ここで調整します）
Private Const X1 As String = "A5"
Private Const X2 As String = "A7"
Private Const S1 As String = "C3"
Private Const T1 As Double = 1000

Sub Button_Click_1()
Dim col As Long
Dim Sr As Range
Dim Result As Variant
Set Sr = Range(S1)
If Sr.Value <> "" Then
　Do Until Sr.Offset(1).Value = ""
　Set Sr = Cells(Sr.Row, Columns.Count).End(xlToLeft)
　If Sr.Offset(1).Value <> "" And Sr.Value <> "" Then Exit Do
　Loop
　Result = Range(X1).Value * Range(X2).Value * Sr.Value / T1
　Sr.Offset(1).Value = Result
　Set Sr = Cells(Sr.Row, Columns.Count).End(xlToLeft).Offset(, 1)
　End If
'　If Result > 100 Then
' 画像を読み込む
'　Call PictureImport(Sr.Offset(5))
'　End If
End Sub

Function PictureImport(ByRef rng As Range)
　Dim FileName As Variant
　Dim mPath As String
　Dim orgPath As String
　Dim objShape As Shape
　　orgPath = ThisWorkbook.path
　　
　　mPath = CreateObject("Shell.Application").Namespace(&H27).Self.path
　　
　　ChDir mPath
　　FileName = Application.GetOpenFilename _
　　("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "画像選択ダイアログ")
　　If VarType(FileName) = vbBoolean Then Exit Function
　　Set objShape = ActiveSheet.Shapes.AddPicture( _
　　FileName:=FileName, _
　　LinkToFile:=False, _
　　SaveWithDocument:=True, _
　　Left:=rng.Left, _
　　Top:=rng.Top, _
　　Width:=50#, _
　　Height:=50#)
　　ChDir orgPath
End Function

No.5 回答者： WindFaller 回答日時： 2017/04/28 16:36

今回のマクロは、まったくマクロを知らない人が、新規ブックにでも、標準モジュールに貼り付けて、マクロを呼び出したら、ワークシートに現れるという趣旨のもとですから、これを応用しようとしても、私自身でも、難しいのです。

>早速打ち込んで試してみたのですが、「型が一致しません」と出てしまいました

新規ブックで、掲示板に出ているコードを「標準モジュール」に貼り付ける分には、どこにもエラーが出る様子はありませんが、セルの位置を変えようとしたり、すでにボタンがある場合は、このマクロは動きません。もともと、私自身が、遊び心ですから、あまり先のことを考えずに作られています。ただし、いくつかのワザを組み入れた内容です。

>”Buttons.Count”　を２にすればいいのでしょうか？？
単純にはできません。コードを書き換えないとできないようです。

セル位置の変更は、ずっと下の方にある、T1,T2 の部分です。

Set T1 = Range("A5"): Set T2 = Range("A7")

以下はほんのおまけです。あってもなくても本筋には関係ありません。
Range("A5,A7," & DCellName).Borders.ColorIndex = 5
5は、色インデックスの5（青）のことです。

さて、本格的に実用になると、内容は、もっとシンプルになるように考えますが、どうするべきか、どのぐらいおわかりになるかにもよります。
まあ、もう一度書き直しはしますが、ダメだったら、Excel か、VBのカテゴリでご質問されるようにお願いします。

No.4 回答者： WindFaller 回答日時： 2017/04/28 11:47

#3のイメージ画像を載せておきます。

このボタンは入力するたびに自動的に動きます。

No.3 回答者： WindFaller 回答日時： 2017/04/27 21:44

こんばんは。

>ちょっとした遊び心的な（笑）
遊び心を満喫させるコードというのは、これは大変に難しい。

>一定の数字以上以下で画像を読み込めるマクロも組み込みたいなと思っていました。

後は考えてみてください。
といっても、私のマクロは、半年過ぎたら他人のコードで、私にもわからなくなってしまいます。以下のコードは、あっちこっちコードが飛んだり途切れたりします。

以下は標準モジュールに貼り付けます。
マクロ名　PlayCalculationStart　を起動します。
なお、新規のシートか、フォームコントロール・ボタンのないシートで実行してください。

'//
Option Explicit

Dim btnCount As Long
Dim Rng As Range
Const DCellName As String = "C3"
Sub PlayCalculationStart()　'このプロシージャがスタート
Range("A5,A7," & DCellName).Borders.ColorIndex = 5
Set Rng = Range(DCellName)
If ActiveSheet.Buttons.Count = 0 Then
　Call FormButtonCtrl(Rng)
End If
End Sub
Private Sub FormButtonCtrl(Rng As Range)
Dim myBtn As Object
Dim btnName As Variant
Dim x1#, x2#, y1#, y2#
On Error Resume Next
btnName = Application.Caller
Set myBtn = ActiveSheet.Buttons(btnName)
If Err = 0 Then
　 With myBtn.TopLeftCell
　　 myBtn.Left = .Offset(, 1).Left
　 End With
　 Exit Sub
End If
On Error GoTo 0

'Initiation
If Rng.Row < 3 Then
　MsgBox "パラメータは2行以下は設定できません。", vbCritical
　Exit Sub
End If
If ActiveSheet.Buttons.Count > 1 Then
　 MsgBox "ボタンが2個以上あると、このマクロは実行できません。", vbCritical
　 Exit Sub
End If
With Rng.Cells(1).Offset(-1)
　x1 = .Left
　y1 = .Top
　x2 = .Offset(, 1).Left
　y2 = .Offset(1).Top
End With
With ActiveSheet.Buttons.Add(x1, y1, x2 - x1, y2 - y1)
　.Name = "PlayCalc"
　.Caption = "合計"
　.OnAction = "CalculateSum"
End With
End Sub
Private Sub CalculateSum()
Dim T1 As Range
Dim T2 As Range
Dim myBtn As Object
Dim btnName　As String
Dim i As Long, j As Long, t As Long
Dim cl As Long, clb As Long
Set T1 = Range("A5"): Set T2 = Range("A7")
Dim Dv As Double
Dv = 1000
On Error Resume Next
btnName = Application.Caller
Set myBtn = ActiveSheet.Buttons(btnName)
If Err <> 0 Then MsgBox "エラーが発生しました。", vbCritical: Exit Sub
On Error GoTo 0
cl = myBtn.TopLeftCell.Column　　'この周辺は最も弱い部分
clb = myBtn.BottomRightCell.Column
Set Rng = Cells(Range(DCellName).Row, Int((cl + clb) / 2))
i = Application.Count(T1, T2, Rng)
If i < 3 Then
　 MsgBox CStr(3 - t) & "つの値が不足しています", vbExclamation
　 Exit Sub
End If
j = Rng.Column - Range(DCellName).Column
Rng.Offset(1).Value = T1.Value * T2.Value * Rng.Value / Dv
Rng.Offset(2).Value = Application.Sum(Range(DCellName).Offset(1).Resize(, j + 1))
If Rng.Offset(1).Value <> 0 Then
　 Call FormButtonCtrl(Rng)
End If
End Sub

No.2 回答者： fujillin 回答日時： 2017/04/27 09:25

ANo1です。

＞～～やってみましたが、うまくいきません
おや、そうですか。残念でした。

情報がまったくないので推測すらできませんが、セル範囲が違うとか、操作が違うとか、はたまた、ご質問文が違うとかなどなどではないかと思います。

No.1 回答者： fujillin 回答日時： 2017/04/26 16:42

こんにちは

縦なのか横なのかよくわかりませんが、ご質問の内容であればマクロの記録で十分作成可能と思います。

以下の手順で可能だと思います。
1）「=$A$5*$A$7*C3/1000」の式を該当セルに入力
　（ご質問文ではどこか不明ですが、質問者様はわかるはず）
2）**** ここでマクロの記録を開始 ****
3）1）で式を入力したセルを選択し、式を縦（または横？）にフィルコピー
4）合計を出したいセル（下のセル？？）に「=SUM(範囲)」の式を入力
　（範囲はどこなのかわかりませんが、合計対象のセル範囲を適切に設定してください）
5）**** ここでマクロの記録を終了 ****
6）ボタン等を作成し、上記ののマクロを登録

以後は、ボタンを押せば、上記のマクロが実行されるようになります。
マクロの内容を見たり、修正したりなさりたいときは、Alt+F11またはリボンのメニューからVBAエディターを開いてください。