こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

実力がなくマクロがわかりません。
C列の一番最後に入力された数字と一つ前の数字を比較し同じなら、E列の一番最後
に入力された数字とJ列一つ前の数字を足しJ列の一番最後にその数字を入力する。
違うならE列の一番最後に入力された数字入力する。
例えば、C8=0・C9=1、E9=500・E8=600・J8=600の時は、
J=9に500と表示さす。
またこの状態でC10=1、E10=1500時は、J=10に2000と表示さす。
関数を使うとセルJ9には=IF(C9=C8,E9+J8,E9)、
セルJ10にはIF(C10=C9,E10+J9,E10)で出来ますが、
以後11行目12行目・・・と永遠にJ列に関数をコピーしないと駄目なのです。
E列に数字が入った時に自動でJ列に表示さすにはマクロでやるしか無理みたいですが
こちらはそこまで実力がありません。丸投げになりますが、よろしくお願い致します。
 7行   C列     E列        J列
 8行    0     600       600  
 9行    1     500       500
10行    1    1500      2000  

投稿日時 - 2010-08-08 11:37:39

QNo.6094880

困ってます

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

こちらをどうぞ。なお、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

投稿日時 - 2010-08-11 15:32:57

お礼

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

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

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

投稿日時 - 2010-08-12 14:14:25

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(11)

ANo.11

> セルJ8~M8に文字及び罫線等を入力すると9行目を飛ばし10行目
> から表示されます。
> 回数の所も2と表示されます。以後は11行目の回数の所は3と表示さ
> れます。

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

投稿日時 - 2010-08-12 16:30:53

お礼

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

投稿日時 - 2010-08-13 20:42:23

ANo.9

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

Application.ScreenUpdating = True

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

投稿日時 - 2010-08-10 17:56:55

補足

ありがとうございます。ANo.8でこちらの思っていたとおりできました。もう少しお願いできませんですか。C列が日付でJ列はE列の合計です。もう少し工夫をしようと思いました。J列の合計ですが一日の最後に表示し、それ以外の表示の色を白で表示することで見えません。こうすることで一日一日の合計みの表示となり見やすくなります。日付でE列の合計をJ列に表示しています。すみませんが、追加で日付でF列の合計をK列にまた、日付でG列の合計をL列にまた、日付でH列の合計をM列にお願いいたします。
  C  E  F  G  H   J  K  L  M
  1  2  3  4  5   2  3  4  5
  2  1  2  3  4
  2  3  4  5  6   4  6  8 10
  3  1  2  3  4 
  3  2  4  6  8
  3  1  3  5  7
  3  9  8  7  6  13 17 21 25

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

投稿日時 - 2010-08-10 22:28:04

ANo.8

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

投稿日時 - 2010-08-10 15:36:35

ANo.7

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

投稿日時 - 2010-08-10 12:17:01

ANo.6

#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

投稿日時 - 2010-08-10 09:35:11

補足

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

投稿日時 - 2010-08-10 21:37:59

お礼

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

投稿日時 - 2010-08-12 14:18:34

ANo.5

下から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

投稿日時 - 2010-08-09 23:50:15

ANo.4

こんな感じでどうですか。
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列の複数のセルに数値をコピーする場合にも対応しています。

投稿日時 - 2010-08-08 16:02:34

補足

もっと詳しく書かないですみません。実際は、C列の9行目にに入力するとB列に回数が入るプログラムがあります。このプログラムもOKウエーブで7、8年前に教えてもらったものです。
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列、9行目より下
If rg.Column = 3 And rg.Row >= 3 Then
If rg.Text <> "" Then
rg.Offset(0, -1) = rg.Row - 8 '9行目より下
Else
rg.Offset(0, -1) = ""
End If
End If
Next
Application.EnableEvents = True
Exit Sub
ErrorHandler:
Application.EnableEvents = True
End Sub
のプログラムがあります。エンドサブの前にそちらのプログラムを書き込みましたがうまくいきません。
忙しいところすみませんが、よろしくお願いいたします。

投稿日時 - 2010-08-09 21:40:52

ANo.3

少し気になるのは、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

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

投稿日時 - 2010-08-08 15:08:33

ANo.2

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

投稿日時 - 2010-08-08 14:30:02

お礼

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

投稿日時 - 2010-08-12 14:22:35

ANo.1

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

投稿日時 - 2010-08-08 12:32:38

補足

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

投稿日時 - 2010-08-08 14:05:32

あなたにオススメの質問