エクセルVBAでマクロの計算式を変更したい

前へ 次へ
このQ&Aのポイント
  • エクセルのVBAで作成したマクロの計算式を変更したいです。現在の計算式ではD5の値を100下げるごとにD6の値が+4され、D5の値を100上げるごとにD6の値が-4されます。同様に、E5の値を100下げるごとにE6の値が+4され、E5の値を100上げるごとにE6の値が-4されます。しかし、私はD5の値を100下げるごとにD6の値が+4され、D5の値を100上げるごとにD6の値が-8されるように変更したいです。同様に、E5の値を100下げるごとにE6の値が+4され、E5の値を100上げるごとにE6の値が-8されるように変更したいです。
  • エクセルのVBAで作成したマクロの計算式を変更したいです。現在の計算式ではD5の値を100下げるごとにD6の値が+4され、D5の値を100上げるごとにD6の値が-4されます。同様に、E5の値を100下げるごとにE6の値が+4され、E5の値を100上げるごとにE6の値が-4されます。しかし、私はD5の値を100下げるごとにD6の値が+4され、D5の値を100上げるごとにD6の値が-8されるように変更したいです。同様に、E5の値を100下げるごとにE6の値が+4され、E5の値を100上げるごとにE6の値が-8されるように変更したいです。
  • エクセルのVBAで作成したマクロの計算式を変更したいです。現在の計算式ではD5の値を100下げるごとにD6の値が+4され、D5の値を100上げるごとにD6の値が-4されます。同様に、E5の値を100下げるごとにE6の値が+4され、E5の値を100上げるごとにE6の値が-4されます。しかし、私はD5の値を100下げるごとにD6の値が+4され、D5の値を100上げるごとにD6の値が-8されるように変更したいです。同様に、E5の値を100下げるごとにE6の値が+4され、E5の値を100上げるごとにE6の値が-8されるように変更したいです。
回答を見る
  • ベストアンサー

エクセル VBAについて。その２

以前、こちらの掲示板でお世話になった者です。 　 Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$C$5" Select Case Target.Value Case 1 Range("C6").Value = 24 Range("D5").Value = 600 Range("D6").Value = 0 Range("E5").Value = 400 Range("E6").Value = 0 Case 2 Range("C6").Value = 32 Range("D5").Value = 1000 Range("D6").Value = 0 Range("E5").Value = 500 Range("E6").Value = 0 End Select Case "$D$5" Select Case Range("C5").Value Case 1 Range("D6").Value = (600 - Range("D5").Value) / 25 Case 2 Range("D6").Value = (1000 - Range("D5").Value) / 25 End Select Case "$E$5" Select Case Range("C5").Value Case 1 Range("E6").Value = (400 - Range("E5").Value) / 50 Case 2 Range("E6").Value = (500 - Range("E5").Value) / 50 End Select と、上記のようなマクロがお手伝いしていただいた結果、完成しました。 C５に1を代入した場合 D5 = 600 D6 = 0 E5 = 400 E6 = 0 C５に2を代入した場合 D5 = 1000 D6 = 0 E5 = 500 E6 = 0 　 C５に1を代入しており、D5の値を500に下げた時 D6 = 4 （D5の値を100下げる毎にD6の値に+4 ) （D5の値を100上げる毎にD6の値に-4 ） C５に1を代入しており、E5の値を300に下げた時 D6 = 4 （E5の値を100下げる毎にE6の値に+4 ) （E5の値を100上げる毎にE6の値に-4 ) ＜以下、Ｃ５に2を代入した時のケースを省略。＞ 　 というような意味合いのマクロになったと思いますが、少々困ったことが発生しました。 （D5の値を100下げる毎にD6の値に+4 ) （D5の値を100上げる毎にD6の値に-4 ） （E5の値を100下げる毎にE6の値に+4 ) （E5の値を100上げる毎にE6の値に-4 ) この部分を （D5の値を100下げる毎にD6の値に+4 ) （D5の値を100上げる毎にD6の値に-8 ） （E5の値を100下げる毎にE6の値に+4 ) （E5の値を100上げる毎にE6の値に-8 ) に変更したいのですが、計算式がわかりません（？ω？） どなたかご指導のほどよろしくお願いします。

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

  • ベストアンサー
  • hananoppo
  • ベストアンサー率46% (109/235)
回答No.1

こんな感じでいかがでしょう。 Private Sub Worksheet_Change(ByVal Target As Range) Dim 初期値 As Integer Dim 増減値 As Integer Select Case Target.Address Case "$C$5" Select Case Target.Value Case 1 Range("C6").Value = 24 Range("D5").Value = 600 Range("E5").Value = 400 Case 2 Range("C6").Value = 32 Range("D5").Value = 1000 Range("E5").Value = 500 End Select Case "$D$5" Select Case Range("C5").Value Case 1 初期値 = 600 Case 2 初期値 = 1000 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("D6").Value = (初期値 - Target.Value) / 100 * 増減値 Case "$E$5" Select Case Range("C5").Value Case 1 初期値 = 400 Case 2 初期値 = 500 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("E6").Value = (初期値 - Target.Value) / 100 * 増減値 End Select End Sub

  1. カテゴリ
  2. パソコン・スマートフォン
  3. Windows
  4. Windows XP

関連するQ&A

  • VBA　のエラーがわかりません・・・ｗ

    Sub Worksheet_Change(ByVal Target As Range) Dim 初期値 As Integer Dim 増減値 As Integer Select Case Target.Address Case "$C$5" Select Case Target.Value Case 1 Range("C6").Value = 24 Range("D5").Value = 600 Range("D6").Value = 0 Range("E5").Value = 400 Range("E6").Value = 0 Range("B7").Value = "★1 MaxAttackPoint:700 / MaxDeffencePoint:900" Case 2 Range("C6").Value = 32 Range("D5").Value = 1000 Range("D6").Value = 0 Range("E5").Value = 500 Range("E6").Value = 0 Range("B7").Value = "★2 MaxAttackPoint:1100 / MaxDeffencePoint:1300" End Select Case "$D$5" Select Case Range("C5").Value Case 1 初期値 = 600 Case 2 初期値 = 1000 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("D6").Value = (初期値 - Target.Value) / 100 * 増減値 Case "$E$5" Select Case Range("C5").Value Case 1 初期値 = 400 Case 2 初期値 = 500 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("E6").Value = (初期値 - Target.Value) / 200 * 増減値 End Select End Sub Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$F$5" Select Case Target.Value Case "炎" Range("F6").Value = 4 Case "水" Range("F6").Value = 4 End Select 　 Case "$G$5" Select Case Target.Value Case "ドラゴン" Range("G6").Value = -8 Case "海竜" Range("G6").Value = -8 End Select Case "$H$5" Select Case Target.Value Case "ドラゴン" Range("H6").Value = -16 Case "海竜" Range("H6").Value = -16 End Select Case "$I$5" Select Case Target.Value Case "○" Range("I6").Value = 40 Case "×" Range("I6").Value = 0 End Select End Select End Sub とあるカードゲームのステータス決定を行う為に組まれたマクロです。 作成者は私だけではないのですが、もう何回もしつこく質問をしているため 気が引けてしまい、こちらで質問することにしました・・・ｗ 　 エラー内容は ２つ目のSub Worksheet_Change(ByVal Target As Range)の 「Worksheet_Change」の名称が間違っています。 という事でした。何を入れればいいのかサッパリです(；´ω) 　 エラーの改善方法について教えてください。 宜しくお願いします

  • ExcelのVBAで教えてください。

    Private Sub Worksheet_Changeについて教えて下さい。 まず初歩的なご質問ですが、Private Sub Worksheet_Changeを1つのシートモジュールに1個以上組むことは可能なのでしょうか？ 例えばネットで以下のようにsheet1に Private Sub Worksheet_Change Private Sub Worksheet_Change_1 _1を付けてるのを見たことがあったので試してみましたが動作しませんでした。 今回行いたいのは1つが、指定したセルが変更されると次の指定セルに移動する。 以下がマクロです。 Private Sub Worksheet_Change(ByVal Target As Excel.Range) Select Case Target.Address(0, 0) Case "E14" [E15].Select Case "E15" [E26].Select Case "E26" [E22].Select Case "E22" [E25].Select Case "E25" [E29].Select Case "E29" [E20].Select Case "E20" [E21].Select Case "E21" [E16].Select Case "E16" [E17].Select Case "E17" [E27].Select Case "E27" [E23].Select Case "E23" [E24].Select Case "E24" [E28].Select Case "E28" [E18].Select Case "E18" [E19].Select End Select End Sub もう一つが、あるセルに数値をいれると他のブックのシートからそのシートの指定した行のセルの 数値を読み込んできて、元のブックのシートに数値を書き込むといったもです。 以下がマクロです。 Private Sub Worksheet_Change_1(ByVal Target As Excel.Range) Dim w As Workbook Dim c As Range On Error Resume Next Set xCur = Selection If Application.Intersect(Target, Range("F3")) Is Nothing Then Exit Sub If Range("F3") = "" Then Exit Sub Application.ScreenUpdating = False '転記元のブックを開いて逆順で検索する Set w = Workbooks.Open("V:\新３係（ＦＩＡ・ｉＰｏｔ）\(2)新４係（ｉＰｏｔ）\ipot進捗\履歴管理\(9)KBB39360　X8 imm1.35 Ｇ１履歴、本体履歴　.xls") Set c = w.Worksheets("対物").Range("B:B").Find(what:=Range("F3").Value, LookIn:=xlValues, lookat:=xlPart, searchdirection:=xlPrevious) '見つけた（一番下の）セルを基準に転記する If Not c Is Nothing Then Range("F4").Value = c.Offset(0, 1).Value End If w.Close False Application.ScreenUpdating = True End Sub ともに1つずつなら問題なく動作するのですが、2個のマクロを組むと片方しか動作しません。 多分ものすごく初歩的な事だとは思いますが、御指導の程宜しくお願いします。

  • EXCEL 異なるVBA

    教えて下さい、EXECL以下の異なるVBA (A>,B>)が２つあります、同じシートでそれぞれ動くようにさせたいです1つに合わせる事は出来ないでしょうか? 当方初心者の為わかりません教えて下さい。 A> Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address(0, 0, xlA1, 0) <> "A1" Then Exit Sub With Range("F9:I9,K17:K36").Borders(xlDiagonalUp) If Left$(Target.Value, 1) = "S" Then .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic Else .LineStyle = xlNone End If End With End Sub B> Private Sub Worksheet_Change(ByVal Target As Range) With Sheet2 Select Case Target.Address Case Is = "$D$1" .Range("A1").Insert Shift:=xlDown .Range("A1").Value = Target.Value Case Is = "$D$2" .Range("B1").Insert Shift:=xlDown .Range("B1").Value = Target.Value End Select End With End Sub

  • エクセルＶＢＡについて

    http://okwave.jp/qa/q7236213.html 上記質問の発展形なのですが 同様のことを Ｅ列に日付 Ｆ列に売上 Ｇ列に結果 でやりたいのですが この時Ａ列～Ｃ列のマクロも残したままでしたいのですが 下記のように同様のプロシージャーを下段に書けばできると思ったのですが うまくいきません。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$A$1" Then Exit Sub If Target = "" Then Exit Sub Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With End Sub Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$E$1" Then Exit Sub If Target = "" Then Exit Sub Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With End Sub どなたかお知恵を拝借できませんでしょうか？

  • Excel VBA　イベントプロシージャを２つ記述する（基本です）

    基本的な事なのですが、Excelのイベントプロシージャで２つプログラムを作るにはどうやって記述すればよいのでしょうか？ 具体的には、worksheetのchangeイベントで、セルC5の値を変えた時と、セルG7の値を変えた時の２通りのマクロを作成したいのです。 Private Sub Worksheet_Change(ByVal Target As Range) C5を変えた時の処理 End Sub Private Sub Worksheet_Change(ByVal Target As Range) G7を変えた時の処理 End Sub このように書けばよいのでしょうか？そうするとTargetがかぶっておかしくなる気がします。。 お願いします。

  • エクセルのマクロ

    セルの値が変わったら動くマクロですが、2つ書くとエラーが出ます。 どのように直したらいいでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address If Intersect(Target, Range("EK22")) Is Nothing Then Exit Sub Else Range("EK24:EM28").Select Selection.ClearContents End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("EK24")) Is Nothing Then Exit Sub Else Range("EK27:EM28").Select Selection.ClearContents End If End Sub

  • エクセルVBAのDeleteキーによるエラー

    VBA初心者です。エクセル(2003)のVBAについて質問です。 セルに何か値が入力されたら、隣のセルに「TRUE」と入力し、 入力が消去されたら、隣のセルに「FALSE]と入力されるマクロを作成しています。 下記のコードをシートモジュールに入力し、 標準モジュールにはそれぞれ呼び出し用のマクロを入力しています。 A列とB列は結合されていて、その結合されたA・B列のセルに値が入力されたり消去されたりすると 隣のC列に結果が入力されるようにしたいのですが、 A・B列の値をDeleteキーで消去するとエラーになってしまいます。 BSキーで値を消去するとエラーは出ません。 Deleteキーでもエラーが出ない様にする方法はありますでしょうか。 どなたかご教授お願いします。 ----------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:B1,A3:B3,A5:B5")) Is Nothing Then If Target.Value <> "" Then Select Case Target.Address(0, 0) Case "A1" Call マクロ1_TRUE Case "A3" Call マクロ3_TRUE Case "A5" Call マクロ5_TRUE End Select ElseIf Target.Value = "" Then Select Case Target.Address(0, 0) Case "A1" Call マクロ1_FALSE Case "A3" Call マクロ3_FALSE Case "A5" Call マクロ5_FALSE End Select End If End If End Sub

  • エクセルのVBAについて教えてください。

    エクセルのVBAについて教えてください。 下記のような構文で、Dの行にAやBの文字が入力された時、その都度 セルの色が変わるようにはできたのですが、本当は、「C5」セルに文字が 入力された時、「C5」だけでなく「B5：J5」の範囲でセルの色を変えたい のですが、どうすれば良いのでしょうか。 ご存知の方是非教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer If Target.Count > 1 Then Exit Sub If Target.Column <>4 Then Exit Sub Select Case Target.Value Case "A" myColor = 34 '水色 Case "B" myColor = 40 '肌色 Case Else myColor = xlNone End Select Target.Interior.ColorIndex = myColor End Sub

  • Worksheet_changeイベントが動作しない

    Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$D$224" If Target.Value = "" Then Range("D224").Value = "-" End If End Select End Sub DeleteキーでD224をクリアした場合、D224に"-"が入力されません。 D224はD225と結合してあります。 select～caseを使ってdeleteキーで"-"が入力されるような動作を教えてください・・よろしくおねがいします。。。

  • エクセルのＶＢＡで条件付でフォントを変更したいのですが

    たとえばD19のセルには他のセルに入力された文字数が表示されるようLEN(C19)といったような関数が入力されています。D19の値が20より大きければE19のフォントは20にそれ以外なら11にしたいとします。 ちなみにE19も関数が入力さています。 下記でよいのかなと思ったのですが・・・ 直接数値を入力する場合はちゃんと動くのですがD19が数式になるとうまく行きません。どなたか教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$19" Then If Target.Value > 20 Then Range("E19").Font.Size = 20 Else Range("E19").Font.Size = 11 End If End If End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する