実力がなくマクロがわかりません。

質問

実力がなくマクロがわかりません。
Ｃ列の一番最後に入力された数字と一つ前の数字を比較し同じなら、Ｅ列の一番最後
に入力された数字とＪ列一つ前の数字を足しＪ列の一番最後にその数字を入力する。
違うならＥ列の一番最後に入力された数字入力する。
例えば、Ｃ８＝０・Ｃ９＝１、Ｅ９＝５００・Ｅ８＝６００・Ｊ８＝６００の時は、
Ｊ＝９に５００と表示さす。
またこの状態でＣ１０＝１、Ｅ１０＝１５００時は、Ｊ＝１０に２０００と表示さす。
関数を使うとセルＪ９には＝ＩＦ(Ｃ９＝Ｃ８,Ｅ９＋Ｊ８,Ｅ９)、
セルＪ１０にはＩＦ(Ｃ１０＝Ｃ９,Ｅ１０＋Ｊ９,Ｅ１０)で出来ますが、
以後１１行目１２行目・・・と永遠にＪ列に関数をコピーしないと駄目なのです。
Ｅ列に数字が入った時に自動でＪ列に表示さすにはマクロでやるしか無理みたいですが
こちらはそこまで実力がありません。丸投げになりますが、よろしくお願い致します。
　７行　　　Ｃ列　　　　　Ｅ列　　　　　　　　Ｊ列
　８行　　　　０　　　　　６００　　　　　　　６００　　
　９行　　　　１　　　　　５００　　　　　　　５００
１０行　　　　１　　　　１５００　　　　　　２０００

回答No.10

hananoppo · ベストアンサー

こちらをどうぞ。なお、J～M列には条件付き書式が設定されるので、一日の合計以外のセルはフォントの色が白になります。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OneColumn As Range
Dim OneCell As Range

Application.EnableEvents = False
Application.ScreenUpdating = False
For Each OneColumn In Target.Columns
Select Case OneColumn.Column
Case 3
For Each OneCell In OneColumn.Cells
If OneCell.Row > 8 Then
If OneCell.Value = "" Then
OneCell.Offset(0, -1).ClearContents
Else
OneCell.Offset(0, -1).FormulaR1C1 = "=ROW()-8"
End If
End If
Next OneCell
Case 5, 6, 7, 8
For Each OneCell In OneColumn.Cells
If OneCell.Row > 8 Then
With OneCell.Offset(0, 5)
If OneCell.Value = "" Then
.ClearContents
.FormatConditions.Delete
Else
.FormulaR1C1 = "=IF(RC3=R[-1]C3,RC[-5]+R[-1]C,RC[-5])"
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=$C$" & OneCell.Row & "=$C$" & OneCell.Row + 1
.FormatConditions(1).Font.ColorIndex = 2
End If
End With
End If
Next OneCell
End Select
Next OneColumn
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

お礼

適切な回答ありがとうございます。一つうまくいかないことがありました。
セルＪ８～Ｍ８に文字及び罫線等を入力すると９行目を飛ばし１０行目から表示されます。
回数の所も２と表示されます。以後は１１行目の回数の所は３と表示されます。
本当は９行目から表示で回数の所も１と表示したいのですので、色々と試行錯誤(ごまかし)をして
何とかできました。セルＪ８～Ｍ８所だけ、図形のテキストボックスと図形の罫線を使いました。

こちらの思っていたとおりに出来ました。
色々お世話になり、また無理ばっかり言ってすみませんでした。

またＶＢＥ質問の時は、でひともよろしくお願い致します。
　　今回はどうもありがとうございました。
kkazumi

回答No.11

hananoppo

> セルＪ８～Ｍ８に文字及び罫線等を入力すると９行目を飛ばし１０行目
> から表示されます。
> 回数の所も２と表示されます。以後は１１行目の回数の所は３と表示さ
> れます。

このマクロは、C、E～H列の9行目以降に入力があった時だけ実行されます。
しかも、反映されるのは入力されたセルのある行だけです。これらの列の入力済みデータのある行には反映されません。
反映させるためには再入力する必要があります。C、E～H列の入力済みデータを範囲指定して、同じ所にコピーしてください。これで再入力したことになり、他の列に反映されるはずです。
特にJ～M列では、条件付き書式を絶対参照で設定しているので、他のセルからコピーしてもうまく表示されません。

お礼

説明までありがとうございました。また、ほかのＶＢＥの質問の時はよろしくお願いいたします。
今回は、どうもありがとうございました。

回答No.9

hananoppo

ANo.8の下から3行目のNext OneColumnの次に、以下の行を挿入してください。

Application.ScreenUpdating = True

これがないと不具合が生じる場合があるようです。

補足

ありがとうございます。ANo.8でこちらの思っていたとおりできました。もう少しお願いできませんですか。Ｃ列が日付でＪ列はＥ列の合計です。もう少し工夫をしようと思いました。Ｊ列の合計ですが一日の最後に表示し、それ以外の表示の色を白で表示することで見えません。こうすることで一日一日の合計みの表示となり見やすくなります。日付でＥ列の合計をＪ列に表示しています。すみませんが、追加で日付でＦ列の合計をＫ列にまた、日付でＧ列の合計をＬ列にまた、日付でＨ列の合計をＭ列にお願いいたします。
　　Ｃ　　Ｅ　　Ｆ　　Ｇ　　Ｈ　　　Ｊ　　Ｋ　　Ｌ　　Ｍ
　　１　　２　　３　　４　　５　　　２　　３　　４　　５
　　２　　１　　２　　３　　４
　　２　　３　　４　　５　　６　　　４　　６　　８　１０
　　３　　１　　２　　３　　４　
　　３　　２　　４　　６　　８
　　３　　１　　３　　５　　７
　　３　　９　　８　　７　　６　　１３　１７　２１　２５

忙しいと思いますがよろしくお願いいたします。

回答No.8

hananoppo

ANo.7です。更に、C列とE列の同時コピー・削除にも対応するように変更しました。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OneColumn As Range
Dim OneCell As Range

Application.ScreenUpdating = False
Application.EnableEvents = False
For Each OneColumn In Target.Columns
Select Case OneColumn.Column
Case 3
For Each OneCell In OneColumn.Cells
If OneCell.Row > 8 Then
If OneCell.Value = "" Then
OneCell.Offset(0, -1).ClearContents
Else
OneCell.Offset(0, -1).FormulaR1C1 = "=ROW(RC)-8"
End If
End If
Next OneCell
Case 5
For Each OneCell In OneColumn.Cells
If OneCell.Row > 8 Then
If OneCell.Value = "" Then
OneCell.Offset(0, 5).ClearContents
Else
OneCell.Offset(0, 5).FormulaR1C1 = "=IF(RC[-7]=R[-1]C[-7],RC[-5]+R[-1]C,RC[-5])"
End If
End If
Next OneCell
End Select
Next OneColumn
Application.EnableEvents = True
End Sub

回答No.7

hananoppo

ANo.5です。どうせなので全部書き換えてみました。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OneCell As Range

Application.ScreenUpdating = False
Application.EnableEvents = False
Select Case Target.Column
Case 3
For Each OneCell In Target
If OneCell.Row > 8 Then
If OneCell.Value = "" Then
OneCell.Offset(0, -1).ClearContents
Else
OneCell.Offset(0, -1).FormulaR1C1 = "=ROW(RC)-8"
End If
End If
Next OneCell
Case 5
For Each OneCell In Target
If OneCell.Row > 8 Then
If OneCell.Value = "" Then
OneCell.Offset(0, 5).ClearContents
Else
OneCell.Offset(0, 5).FormulaR1C1 = "=IF(RC[-7]=R[-1]C[-7],RC[-5]+R[-1]C,RC[-5])"
End If
End If
Next OneCell
End Select
Application.EnableEvents = True
End Sub

回答No.6

Wendy02

#3の回答者です。
もう少し、人の書いたものをきちんと読んでください。

#3で、
>少し気になるのは、C列の修正はしないのかなって思います。

このように書いています。私はすでに、その問題について気がついているのです。
質問には質問のコツがあります。自分がマクロが出来るという必要性は必ずしもありません。質問して上手に回答を得るもの技術です。回答者も人です。何のコメントも付けずに解答を得られるほど、回答者は機械化してはいません。

二重・三重のイベントというものは、まったく質の違うものです。だいたい、他人のコードに貼り付けて動くっていうのは基本的には考えないでほしいものです。ピンポイントで回答を貰えば解決するとおもうほど、甘くはないってことです。

なお、以下はご質問者が書かれていない部分も含まれています。

'//
Private Sub Worksheet_Change(ByVal Target As Range)
　'現行では貼り付けに対するイベントは起動しません。
　Dim r As Variant
　Dim i As Long
　With Target
　If .Count > 1 Then Exit Sub
　If .Row < 3 Then Exit Sub
　　Application.EnableEvents = False
　　If .Column = 3 Then
　　　If .Value <> "" Then
　　　　.Offset(, -1).Value = .Row - 8
　　　Else
　　　　.Offset(, -1).ClearContents
　　　End If
　　　EnterData .Cells, 2
　 ElseIf .Column = 5 Then
　　　 EnterData .Cells, 0
　 End If
　End With
　Application.EnableEvents = True
End Sub
Function EnterData(rng As Range, ByVal i As Long)
　With rng
　　On Error Resume Next
　　If .Offset(-1, -2 + i).Value = .Offset(, -2 + i).Value Then
　　　.Offset(, 5 + i).Value = .Offset(-1, i).Value + .Offset(, i).Value
　　Else
　　　.Offset(, 5 + i).Value = .Offset(, i).Value
　　End If
　　On Error GoTo 0
　End With
End Function

お礼

色々と考えていただきありがとうございました。やっとこちらの思ったことが出来ました。

補足

回答ありがとうございます。Ｃ列は日付ですので修正はありません。日付ごとの合計をＪ列に表示さそうと思っています。

回答No.5

hananoppo

下から6行目のNextの次に、以下のマクロを挿入してください。

If Target.Column = 5 And Target.Row > 8 Then
For Each rg In Target
If rg.Value = "" Then
rg.Offset(0, 5).Value = ""
Else
rg.Offset(0, 5).FormulaR1C1 = "=IF(RC[-7]=R[-1]C[-7],RC[-5]+R[-1]C,RC[-5])"
End If
Next rg
End If

回答No.4

hananoppo

こんな感じでどうですか。
Visual Basic Editorを開いて、対象のシートに次のマクロをコピーしてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim セル As Range

If Target.Column <> 5 Or Target.Row = 1 Then Exit Sub
For Each セル In Target
If セル.Value <> "" And IsNumeric(セル.Value) Then
セル.Offset(0, 5).FormulaR1C1 = "=IF(RC[-7]=R[-1]C[-7],RC[-5]+R[-1]C,RC[-5])"
End If
Next セル
End Sub

E列の複数のセルに数値をコピーする場合にも対応しています。

補足

もっと詳しく書かないですみません。実際は、Ｃ列の９行目にに入力するとＢ列に回数が入るプログラムがあります。このプログラムもＯＫウエーブで７、８年前に教えてもらったものです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
On Error GoTo ErrorHandler
Application.EnableEvents = False
For Each rg In Target
'B列、９行目より下
If rg.Column = 3 And rg.Row >= 3 Then
If rg.Text <> "" Then
rg.Offset(0, -1) = rg.Row - 8 '９行目より下
Else
rg.Offset(0, -1) = ""
End If
End If
Next
Application.EnableEvents = True
Exit Sub
ErrorHandler:
Application.EnableEvents = True
End Sub
のプログラムがあります。エンドサブの前にそちらのプログラムを書き込みましたがうまくいきません。
忙しいところすみませんが、よろしくお願いいたします。

回答No.3

Wendy02

少し気になるのは、C列の修正はしないのかなって思います。
今は、E列に数字が入った時だけです。C列の修正でJ列も変化するという方法も加えると、Target.Column<> 5 の所で分岐させます。

'//シートモジュール

Private Sub Worksheet_Change(ByVal Target As Range)
　With Target
　If .Value = "" Then Exit Sub
　If .Row < 2 Then Exit Sub
　If .Column <> 5 Then Exit Sub
　If Application.Count(.Offset(-1, -2).Resize(2)) <> 2 Then Exit Sub
　　Application.EnableEvents = False
　　If .Offset(-1, -2).Value = .Offset(, -2).Value Then
　　　.Offset(, 5).Value = .Offset(-1).Value + .Value
　　Else
　　　.Offset(, 5).Value = .Value
　　End If
　　Application.EnableEvents = True
　End With
End Sub

なお、バージョンにもよりますが、フィールドテーブルにしておけば、数式はコピーされるはずです。マクロは実力でなくて、経験かな？

回答No.2

imogasi

これ（プログラム）がどういう場面（バッチかイベントか）で働くのか良くわかりません。まず大枠として、そういうことを説明する必要がある。
（１）データが出来上がっていて、この処理を行うのか（バッチ）（いわゆるイベントの考えはなしで良いのか。入力等されたときに対応するのか（イベント）。
＞Ｅ列に数字が入った時に自動でＪ列に表示さすにはマクロでやるしか、と言っているところを見ると
何処の列のセルの値がChangeしたときに、プログラムを起動すれば良いのか。
（２）＞一つ前の数字を比較
C列は全て（見出し行は別にして）数字が入力されているのか。
間に文字列は無いのか。単純にー１行を見れば良いのか。
（３）全般にデータは１行前部埋まっているのか。空白列があってJ列だけは他列に比して下までデータがあるようなことは無いか。
どうも＞一番最後に入力された数字、と言う表現から、そうでもないのかな
これらは心配です。データ実例をシート全体的に、実例でも挙げてあれば、ある程度類推して心配せずに済むが。
ーーー
C列の最終行は　
Sub test01()
d = Range("C65536").End(xlUp).Row
MsgBox d
End Sub　　
で捉えられるのは有名な話。Cells(d,"C")で最終行の値。
１つ前の行はCells(d-1,"C")
両者を比較すれば良い。
＞Ｅ列の一番最後に入力された数字
途中行で文字入力されないならC列と同じ考え。
＞Ｊ列一つ前の数字を足しＪ
Ｊ列のデータ最終行の一つ前の数字を足し、のことか。
以上を踏まえ質問を書き直してほしいぐらいだ。
＝＝＝＝
以上、列の最終行を捉えるのもありふれたことだし、後は比較とセルに値代入だけではないか。
なぜこの質問する必要があるのかわからない。初心者だといっても。
ーー
またデータ最終行を捉えるユーザー関数を作ると、関数で処理できるような内容では。

お礼

的確な指摘ありがとうございました。やっとこちらの思ったことが出来ました。

回答No.1

hananoppo

予め、J9セルに次の数式を入力し、J10セル以降にコピーしておけばよいのでは？
=IF(E9="","",IF(C9=C8,E9+J8,E9))

補足

最初の質問にも書いていますが、永遠にＪ列に関数をコピーしないと駄目なのです。Ｅ列に数字が入った時に自動でＪ列に表示さすマクロを知りたいのです。この方法ですと、コピーしたセルを越えたら、たまたコピーしないと駄目ですのでＶＢＥでないと方法がないと思います。