• 締切済み

ExcelのＶＢＡにて収支を出すプログラム

マクロで収支を出すプログラムを組みたいのですが、具体的には Ｃ２：今回の収支　→　Ｂ７に反映される。　Ｃ７：前回の収支　Ｄ７：トータル収支 で、今回の収支を入力したらが更新されるプログラムなんですが。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(False, False) <> "C2" Then Exit Sub If Not IsNumeric(Target.Value) Then Exit Sub Range("C7").Value = Range("D7").Value Range("D7").Value = Target.Value + Range("C7").Value End Sub の、プログラムだと特定のセルだけになってしまいます。これにさらに人を認識して更新するプログラムを組みたいのですが上手くいきません。 画像を添付しますが、Ａさんの場合は、Ａさんの収支に反映される。Ｂさんの場合はＢさんの収支に反映される感じで作りたいです。 ちなみに人はプルダウンで変更できるようにしてあります。 どなたか分かる方がいらっしゃいましたら、ご教授をお願いいたします。

画像を拡大する

みんなの回答

回答No.1

C7に数値を入れたら、人を検索し 反映させるという考えで良いんですかね？ このプログラムでやっていることは上記方法と同じだと思います。 前回の収支をトータル収支に置き換えることが出来ませんが、 それ以外はこれで大丈夫かと。 B7　　=IF(VLOOKUP(A7,$B$2:$C$3,2)<>"",VLOOKUP(A7,$B$2:$C$3,2),"") D7　=IF(OR(B7="",C7=""),"",SUM(B7:C7)) 合っているかはわかりませんが、参考まで。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

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

    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 どなたかお知恵を拝借できませんでしょうか？

  • エクセルVBAについて

    エクセルVBAについて 下にある、1行目に入力された数値の、選択したセルの数値を、Ｂ５セルに表示させるマクロなのですが、1行目が結合していると、うまくＢ５セルに表示できません。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) 　If Target.Count > 1 Then Exit Sub　　　　'●複数セル選択は無視 　If Target.Row <> 1 Then Exit Sub　　　　'●１行目以外の選択は無視 　If Target.Column > 6 Then Exit Sub　　　'●Ｆ列目以降の選択は無視 　If Target.Value = "" Then Exit Sub　　　'●選択セルが未入力なら無視 　　　Range("B5").Value = Target.Value End Sub このマクロで、結合しているセルをＢ５に表示させることはできますでしょうか？ 1行目で選択するセルは、すべて2つのセルが結合しています。 よろしくお願いいたします。

  • エクセル　ＶＢＡマクロ if文　はどうすれば？

    先ほど質問したのですが、さらにわからなくなったのでお願いします 先ほどの質問 ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ http://okwave.jp/qa/q7236338.html >変数と式の両立は難しいでしょうからどうすればよいのでしょう？ 　⇒関数では出来無いのはエクセルの常識ですのでマクロ（ＶＢＡ）組込みになります。 一例です。 対象シートタブ上で右クリック→コードの表示→以下のコード貼り付けてA1に枚数を入力して お試しください。 サンプルコード Private Sub Worksheet_Change(ByVal Target As Range) 単価 = 5 If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then 　Application.EnableEvents = False 　Target.Value = Target.Value * 単価 　Application.EnableEvents = True End If End Sub ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ ↓変更＆応用したのですが、、、、 ＥＸ：（セル）　　 　セル番号　　用紙種類１～３　　　　　　　用紙種類 　　　C12　　　Ａ３モノクロ１　　　　　D12　　Ａ３カラー１ 　　　C13　　　Ａ３モノクロ２　　　　　D13　　Ａ３カラー２ 　　　C14　　　Ａ３モノクロ３　　　　　D14　　Ａ３カラー３ ※金額の違いは、モノクロとカラーの値段が違うだけ 　１～３は金額的な違いはない とあった場合、 ためしに先ほどのを応用して用いたのですが 変更点は、用紙サイズ、カラーの有無による金額 　　　　　　　出力先セルの番号 Private Sub Worksheet_Change(ByVal Target As Range) を Private Sub A4_mono_1(ByVal Target As Range) Private Sub A4_mono_2(ByVal Target As Range) ・　 　　　　　　　　　　　・ 　　　　　　　　　　　・ と変更したのですがうまく動作しなかったのですが、 どういった点が悪かったのでしょうか？ ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ 最終的な質問↓ 上記のものはＶＢＡマクロ文は基本１つのみなので、if文で作らなくてはいけないということが分かったのですが、そこでさらに疑問が浮かびました、 Private Sub Worksheet_Change(ByVal Target As Range) If or(target.columns = C12:C14) Then 単価1 = 7.6 If Intersect(Target, Range("C12:C14")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then Application.EnableEvents = False Target.Value = Target.Value * 単価1 Application.EnableEvents = True単価1 = 7.6 elseif or(target.columns = D12:D14) Then 単価2 = 30.6 If Intersect(Target, Range("D12:D14")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then Application.EnableEvents = False Target.Value = Target.Value * 単価2 Application.EnableEvents = True End If End Sub としたっ場合全く式になっていません どのようにすればよいのでしょう？

  • エクセルVBAのイベントで質問です。

    ダブルクリックイベントで、G12:G31の範囲の文字列をB10:B27の範囲(最下行)に入れていくものを使っていますが、新たにH12:H31にある文字列もダブルクリックするとC10:C27の範囲(最下行)に入れていけるようにしたいと思います。 どのようにすればいいでしょうか。 ご存知の方いらっしゃればお教えいただけると助かります。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, _ Cancel As Boolean) Dim i As Long Dim flg As Boolean If Intersect(Target, Range("G12:G31")) Is Nothing Then Exit Sub If IsEmpty(Target.Value) Then Exit Sub With Worksheets("シートＡ") For i = 10 To 27 If .Range("B" & i).Value = "" Then .Range("B" & i).Value = Target.Value flg = True Exit For End If Next i If flg = False Then MsgBox .Name & " がいっぱいです。" End If End With Cancel = True End Sub

  • VBAでコードの編集が上手くいきません

    先日、ご回答頂いたコードを元に自分でいじっているのですが上手く行きません 自分が変更したコード シート1→シート名：変更箇所 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$C$40" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target.Address <> "$C$42" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target.Address <> "$C$44" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value End Sub シート2→シート名：リスト Private Sub worksheet_change(ByVal Target As Excel.Range) Dim i As Long, c As Long Dim h As Range, ha As Range Dim myDic As Object Set ha = Application.Intersect(Target, Range("A:C")) If ha Is Nothing Then Exit Sub Set ha = Application.Intersect(ha.EntireColumn, Range("1:1")) For Each h In ha Set myDic = CreateObject("Scripting.Dictionary") If h.Column = 1 Then c = 3 'A列→C列 If h.Column = 2 Then c = 4 'B列→D列 If h.Column = 3 Then c = 6 'C列→F列 On Error Resume Next For i = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row If Cells(i, h.Column) <> "" Then myDic.Add Cells(i, h.Column).Value, Cells(i, h.Column).Value End If Next i With Worksheets("変更箇所").Cells(40, c).EntireColumn.Validation .Delete .Add Type:=xlValidateList, Formula1:=Join(myDic.keys, ",") End With Set myDic = Nothing Next End Sub シート1において$C$40または$C$42または$C$44のいずれかを変更した場合 最後に変更したセルに対し、シート2にオートフィルタ―がかかる様にしたいと思っています。 試しにシート1を以下のように編集したところ、思った動作を行ったのですが $C$40または$C$42または$C$44のいずれかのセルを空白にすると エラーがでてしまいます。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value End Sub Then Exit Subをどう編集すれば上手く動作するでしょうか？

  • エクセルＶＢＡで最小値を求めたいのですが

    下記はある表の最大値を求めるものですが 同様の条件で最小値を求めようと思い 「MAX」の箇所を「MIN」差し替えてできると思っていたのですが 最小値がのかわりに「0」が表示されてしまいます。 そのように修正すればよいでしょうか？ private sub worksheet_change(byval Target as excel.range) 　if target.cells(1) = "" then exit sub 　if target.address = "$A$1" then 　　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 　elseif target.address = "$E$1" then 　　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 if end sub

  • ２つのVBAを組み合わせる方法

    お世話になります、２つのVBAを組み合わせる方法で迷っています。 １つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。 ２つめが Private Sub Worksheet_Change(ByVal Target As Range)　 Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。２つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか？

  • EXCEL　VBAについて教えてください

    はじめまして。 過去ログに私のやりたいような内容を探していたらこのような下記のエクセルVBAがあったので、教えて頂きたいです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With With Cells(ActiveSheet.Rows.Count, "C").End(xlUp) .Offset(1, 0).Value = x .Offset(1, 1).Value = Time() End With End Sub A1に入力するたびに同一セルに加算。 A1をクリアできる。 C列に入力履歴、D列に入力時間を記録。 If Target.Address <> "$A$1" Then Exit Sub　の$A$1を変えることによって他のセルにも設定できる。 と、いう内容なのですが、これをたとえば同一シートのA1～E10のセルとA12～Ｅ22にも同じよう別々に処理できるように設定したいのですが、どのようにすればいいのでしょうか？ちなみにA11～Ｅ11とA23～Ｅ23は合計を表示するセルにしたいです。 Excelのバージョンは2003です。 よろしくお願い致します

  • 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

  • VBAについて

    以下のプログラムは、1年間の価格合計を求めるプログラムです。 これを実行するとうまくいくこともありますが、エラーが起きることもあります。 どうやら下記コードが原因のようなのですが、間違いがわかりません。 Target.Offset(0, 1).Value = run * (13 - month) どこが間違っているのでしょうか。 また最終的に、A行かB行のどちらかが更新されたときにこのプログラムを 実行させたいのですが、方法がわかりません。 無知な質問ではありますが、どなたか教えてください。 --------------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim month As Integer Dim run As Integer If Intersect(Target, Range("A25:A35")) Is Nothing Then Exit Sub Else If Target.Offset(0, -2).Value <> "" Then month = Target.Offset(0, -2).Value month = month - 3 If month = -2 Then month = 10 ElseIf month = -1 Then month = 11 ElseIf month = 0 Then month = 12 End If run = Target.Offset(0, 0).Value Target.Offset(0, 1).Value = run * (13 - month) End If End If End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する