マクロ データが入力されたら同じ行に式を書き込む

質問

よろしくお願いします。作りたいマクロがあって、毎日少しずつやっています。
自分でも、やりたいことがうまく説明できていないかも知れませんが
その際には、補足説明いたしますので、どなたか教えてください

Ａ１には行数を指定する数値が入力されています　例　５

Ａ１に入力してある数値をマクロでチェックします
１以上２０以下の整数値なら(1)以降の処置をします
それ以外の数値なら無視してなにもしません

(1)Ｃ２からＡ１で指定した行数の範囲で数値が入力されたら(2)をします
例　Ａ１が５なら　入力範囲はＣ２からＣ６になります

(2)Ｄの同じ行に式　＝＄Ａ＄２＊(1)で入力された数値　をマクロで書き込む
例Ｃ２に数値が入力されたらＤ２に式をマクロで書き込みます

(1)で範囲外にデータが入力されたら何もしません（無視します）

以上です。よろしくお願いします

回答No.3

tom04 · ベストアンサー

No.1・2です。
NO.2の件について

（1）　データが入力されたセルの２つ右のセル（Ｂ７で入力されたらＤ７）にＢ７で入力されたデータに
　　次の文字列を加えて書き込みます　頭にＡＡＡ　しっぽにＢＢＢ
　　仮にＢ７で３６００が入力されたらＤ７には　ＡＡＡ３６００ＢＢＢを書きこみます

「AAA」とか「BBB」は変化セルに列に関係なく常に同じ文字でよいのですね？

（3）　入力範囲（仮にＢ７からＢ９）のどれかのデータが削除されたら、右側のＣからＮの行のデータをすべ　　て削除します

「変化したセルの右隣りから12列分を消去」という解釈です。

コード内に若干のコメントを入れておきますので、参考にしてみてください。
今回もシートモジュールです。

Private Sub Worksheet_Change(ByVal Target As Range)
'▼変数の宣言
Dim str As String, c As Range, myRng As Range

On Error Resume Next '←C3～C5データが消去された場合のため★
'▼変化したセルの・・・
With Target
'▼C3:C5セル以外、もしくは範囲内でも複数セルが変化した場合は何もしない
If Not Intersect(Target, Range("C3:C5")) Is Nothing And Target.Count = 1 Then

'▼変化したセルが　C3・C4・C5のいずれかによって処理を分岐
Select Case .Row
Case 3
If Not UCase(StrConv(.Value, vbNarrow)) Like "[A-F]" Then
MsgBox "A～Fまでのセル番号をアルファベットで入力してください。"
.Select
Exit Sub
End If

Case 4
If Not IsNumeric(.Value) Then
GoTo eH1
ElseIf .Value <> Int(.Value) Or .Value < 7 Or .Value > 50 Then
GoTo eH1
End If

Case Else
If Not IsNumeric(.Value) Then
GoTo eH2
ElseIf .Value <> Int(.Value) Or .Value < 1 Or .Value > 100 Then
GoTo eH2
End If
End Select
End If

'▼　str　に　C3の列番号、C4の行番号を文字列として格納
str = StrConv(Range("C3"), vbNarrow) & Range("C4")
'▼　myRng　に　セル番地「str」からC5セルの行数分の範囲を格納
Set myRng = Range(str).Resize(Range("C5").Value)
'▼　変化セルが　myRng　以外の場合は何もしない
If Intersect(Target, myRng) Is Nothing Then Exit Sub
'▼　変化セルを myRng内でループ（複数セルを一気に消去した場合も対応するため）
For Each c In Target
'▼　変化したセルが空白以外の場合
If c <> "" Then
If Not IsNumeric(c) Then
GoTo eH3
Else
c.Offset(, 2) = "AAA" & .Value & "BBB"
c.Offset(, 5) = "CCC" & .Value & "DDD"
End If
'▼　変化セルのデータが消去された場合（空白の場合）
'その行の1列右隣りのセルから12列分のデータを消去
Else
c.Offset(, 1).Resize(, 12).ClearContents
End If
Next c
Exit Sub
eH1:
MsgBox "7～50の整数を入力してください。"
.Select
Exit Sub
eH2:
MsgBox "1～100の整数を入力してください。"
.Select
Exit Sub
eH3:
MsgBox "数値を入力してください。"
.Select
End With
End Sub

※　今回もC3～C5が変化した場合、元々表示されているデータには手を付けていません。
こんな感じではどうでしょうか？m(_ _)m

お礼

お陰様で、希望する動作のマクロでシートが完成しました
マクロは全く未知の世界だったのですが、少しだけ理解できるようになりました

何度も親切に教えていただまして大変感謝いたしております
ありがとうございました

補足

大変お世話になっております。動作確認しました。正常に動いております
これから
c.Offset(, 2)="式"
c.Offset(, 3)="式"
c.Offset(, 4)="式"
こんな感じで式を入れていきます。
マクロに比べれば、式は時間をかければできるので、土日で仕上げて月曜日から仕事で使います
見ず知らずの私にここまで教えていただいて大変恐縮です

昔、Ｎ８８ベーシックとビジュアルベーシックの初歩の経験があって
マクロもなんとかなると思って引き受けたのですが甘かったです

また、今回は注釈を入れていただきまして勉強しやすくなって助かります。
結果はお礼で報告させていただきます

何度もお手数をおかけしました、ありがとうございました。

回答No.2

tom04

No.1です。
補足を拝見しました。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Intersect(Target, Range("A1,C2:C21")) Is Nothing Then Exit Sub
With Target
If .Column = 1 Then
If IsNumeric(.Value) Then
If .Value <> Int(.Value) Then
MsgBox "整数を入力してください。"
.Select
Exit Sub
End If
End If
Else
For Each c In Target
If c.Row <= Range("A1") + 1 Then
If c <> "" Then
c.Offset(, 1).Formula = "=" & .Address(False, False) & "*A2"
Else
Range(Cells(c.Row, "D"), Cells(c.Row, "K")).ClearContents
End If
End If
Next c
End If
End With
End Sub

※　細かい検証はしていません。
A1セルの値が変わった時にC・D列に表示されているデータと数式は消去するのかどうか？
消去しない場合でも、A1セル数値の行より後ろの行のデータの処理はそのままで良いのか？
等々色々問題点も出てくると思います。

本来であれば考えられるエラーに対しての処理が必要なのでしょうが
とりあえずはこの程度で・・・m(_ _)m

お礼

お世話になっております。補足が書けないので、お礼に書かせていただきます
また、私がやっていることは質問ではなくて、マクロの作成依頼になっています
これはｔｏｍ０４さんに大変な負担をかけているのをお詫びします
お手数かけて誠に申し訳ありません

作成していただいたマクロは希望する操作ができています
教えてもらったマクロを１行ずつネットで調べて、自分がやりたいことに直そうと一晩やって見ましたが
手に負えません

シートのスタイルが決まりましたので、度々の依頼で失礼ですが、下記のように直してもらえないでしょうか

データを入力する列はＣ３を参照します　仮にＢとします　入力制限はＡからＦです
制限を外れていたらメッセージボックスで警告します

データを入力する行はＣ４を参照します　仮に７とします　入力制限は７以上５０以下です
制限を外れていたらメッセージボックスで警告します

データを入力する行数はＣ５を参照します　仮に３とします　入力制限は１以上１００以下です
制限を外れていたらメッセージボックスで警告します

この場合、入力範囲はＢ７から３行ですからＢ９になります

この入力範囲（仮にＢ７からＢ９）でデータが入力されたら１以下の処理をします
データの入力制限はありません

入力範囲（仮にＢ７からＢ９）外で入力されたらなにもしません

１　データが入力されたセルの２つ右のセル（Ｂ７で入力されたらＤ７）にＢ７で入力されたデータに
　　次の文字列を加えて書き込みます　頭にＡＡＡ　しっぽにＢＢＢ
　　仮にＢ７で３６００が入力されたらＤ７には　ＡＡＡ３６００ＢＢＢを書きこみます

２　同じく５つ右のセル（Ｂ７で入力されたらにＧ７）のセルにＣＣＣ３６００ＤＤＤを書き込みます

式でも可能ですがマクロで書き込みます

３　入力範囲（仮にＢ７からＢ９）のどれかのデータが削除されたら、右側のＣからＮの行のデータをすべ　　て削除します

作りたいマクロは以上です
また、お願いしていいでしょうか

補足

ありがとうございます。
仕事で遅くなりました。これからやってみます。

回答No.1

tom04

こんばんは！

＞(2)Ｄの同じ行に式　＝＄Ａ＄２＊(1)で入力された数値　をマクロで書き込む
＞例Ｃ２に数値が入力されたらＤ２に式をマクロで書き込みます

あらかじめD列に数式を入れてはいけない訳ですね。
（C列に入力があった行のみD列に数式を入れる）

↓のコードをシートモジュールにコピー＆ペーストして
A1・C列にデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim str As String
If Intersect(Target, Range("A1,C:C")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
If .Value <> "" Then
If .Column = 1 Then
If IsNumeric(.Value) Then
If .Value = Int(.Value) And .Value > 0 And .Value <= 20 Then
Range(Cells(.Value + 2, "D"), Cells(21, "D")).ClearContents
End If
End If
Else
If Range("A1") = Int(Range("A1")) Then
If .Row >= 2 And .Row <= Range("A1") + 1 Then
str = .Address(False, False)
.Offset(, 1).Formula = "=" & str & "*A1"
End If
End If
End If
Else
Range("D2:D21").ClearContents
End If
End With
End Sub

※　一発で解決とはいかないと思いますが。
たたき台としての回答です。m(_ _)m

補足

何度も教えていただきまして誠に申し訳ありません
専属講師常態になってしまって大変恐縮しております

.Offset(, 1).Formula = "=" & str & "*A2"
かけ算の元の数値がＡ２に有りますのでＡ２に直して実行しました
私の希望の動作と計算結果になっております
ただ、大変申し訳ありませんが、問題点として
Ｃ列のどこでもデータを削除するとＤ列の計算結果がすべて削除されてしまいますので
恐縮ですが、Ａ１で指定した行数内のＣ列のデータの一部が削除された時のみ
その右側のＤ列からＫ列までのデータを削除するように出来ますでしょうか

Ａ１（行数の指定）が３の時は、入力範囲（無視しない範囲＝計算する）はＣ２からＣ４になります
これはうまく行っています

もしこのとき、Ｃ２からＣ４の範囲で値がクリアーされたら
その右側の列のＤからＫまでの値をクリアーしたいのですが可能でしょうか？

教えていただく身分で大変恐縮です