次のような作業をマクロを使ってやりたいと考えています。 Sheet1に入力されたデータをSheet2のフォームへの並べ変えと累計を作成したい。 Sheetの特徴と作業イメージは以下の通りです。

画像

Excel | Visual Basic355閲覧xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0

お手間をとらせます。 転記については希望通りになっています。ありがとうございます。 累計については、 ・データの発生がない日は前日の累計値がそのまま入力される ・データの発生がある日は前日の累計値と加算される 累計表の黒字がマクロを実行したときに入力された値、赤字が希望する入力値です。 累積値を毎日のグラフで確認したいための処置です。 よろしくお願いいたします。

画像

ThanksImg質問者からのお礼コメント

投稿したときのブックをコピーして使っていたので、同じものと考えていましたが、元のブックでは全て上手くいきました。 いろいろと操作をしているときに何かが変わってしまったのかもしれません。お手間をとらせて申し訳ありませんでした。 これでだいぶ作業が楽になります。本当にありがとうございました。

お礼日時:2021/12/6 13:24

その他の回答(1件)

0

マクロの関数でのプログラムでないために見づらいかと思いますが、ご了承下さい。 関数の知識がないので我流により以下のようなプログラムとなります。 1.作業を毎日行なうとのことなので前日までに集計された行の「O列」に「済」の表記をするようにしています。 この済の表記がある行は、次回ボタンをクリックしても対象外となります。 「O列」では、邪魔になるのでもっと列を離したければ、プログラム中の「Cells(n0, 15).Value」の「15」を好きな列番号に変更下さい 2.集計が「0」の場合には、空白にするとのことですが、「J列」の集計では「0」が残っていますのでそのままにしています。 3.累計は、1年間を通しての累計としています。 もし月単位での累計にしたければ、 For r = 4 To 7 .Cells(n1 + n2 - 1, r + 8).Value = WorksheetFunction.Sum(Range(.Cells(6, r), .Cells(n1 + n2 - 1, r))) If .Cells(n1 + n2 - 1, r + 8).Value = 0 Then .Cells(n1 + n2 - 1, r + 8).Value = "" End If Next のプログラム中の「.Cells(6, r)」の「6」の値を「n1」に書換え下さい。 確認していませんが、恐らく問題無いと思います。 プログラムは以下のとおりです。 Sub Sheet1_ボタン1_Click() With Worksheets("Sheet2") For n0 = 13 To 378 If Cells(n0, 6).Value = "" Then Exit For ElseIf Cells(n0, 15).Value = "" Then For n1 = 6 To 371 If .Cells(n1, 2).Value = Format(Cells(n0, 2).Value, "m" & "月") Then For n2 = 1 To 31 If n2 <> 1 And .Cells(n1 + n2 - 1, 2).Value <> "" Then For r = 4 To 7 .Cells(n1 + n2 - 1, r + 8).Value = WorksheetFunction.Sum(Range(.Cells(6, r), .Cells(n1 + n2 - 1, r))) If .Cells(n1 + n2 - 1, r + 8).Value = 0 Then .Cells(n1 + n2 - 1, r + 8).Value = "" End If Next Exit For Else If Day(Cells(n0, 2).Value) = .Cells(n1 + n2 - 1, 3).Value Then For r = 1 To 6 Step 2 If Cells(n0, 6).Value = .Cells(4, 3 + r).Value Then If Cells(n0, 14).Value >= 0 Then .Cells(n1 + n2 - 1, 3 + r).Value = .Cells(n1 + n2 - 1, 3 + r).Value + Cells(n0, 14).Value .Cells(n1 + n2 - 1, 10).Value = .Cells(n1 + n2 - 1, 10).Value + Cells(n0, 14).Value Cells(n0, 15).Value = "済" ElseIf Cells(n0, 14).Value < 0 Then .Cells(n1 + n2 - 1, 3 + r + 1).Value = .Cells(n1 + n2 - 1, 3 + r + 1).Value + Cells(n0, 14).Value .Cells(n1 + n2 - 1, 10).Value = .Cells(n1 + n2 - 1, 10).Value + Cells(n0, 14).Value Cells(n0, 15).Value = "済" End If Exit For End If Next Exit For End If End If Next Exit For End If Next End If Next End With End Sub

画像