4年に一度のスポーツの祭典 全競技速報中

Excelにて、コピーして特定セルに張り付けると、特定セルに追番で数字が
入るマクロに下記内容を追加したいのですが、どのように追加修正してよいのか
分からず苦慮しております。


現在は、A~Kを使用しており、Dにコピーしたデーターを貼り付けるとKのセル
に1~追番で数字が入力されます。
sheet1行目には、項目名があり 2行目から入力となります

追加項目
15行以内をコピーしてD列に貼り付けたら、今まで通り追番で数字が入り
15行以上であれば15行毎に+1するようにしたい。

例えば、61行貼り付けたとすると
1~15行は今まで通り、16~30行目は15行目の数字に+1
31~45行は、30行目の数字に+1
46~60行は、45行目の数字に+1

という具合に、15毎に、K列に追番で数字を入れたい。


説明が下手ですみません


お分かりになられる方ご教授願います。

現在のコード

Private Sub Worksheet_Change(ByVal Target As Range)
Dim no As Long
Dim rng As Range
If Target.Row = 1 Or Target.Column <> 4 Then Exit Sub
If Range("K5").Value = "" Then
no = 1
Else
no = Range("K" & Cells(Rows.Count, "K").End(xlUp).Row).Value + 1
End If
Application.EnableEvents = False
For Each rng In Target
If rng.Value = "" Then
rng.Offset(0, 7).Value = ""
Else
rng.Offset(0, 7).Value = no
End If
Next rng
Application.EnableEvents = True
End Sub

質問者からの補足コメント

  • ありがとうございます。
    説明不足ですみません


    添付しました画像は、現状の動作です(NOがK列です)
    追加したいのは、画像最後であれば
    16行分を貼り付けたら前の数字が3なので4が入り
    15行分が4となり16行分は5が入るようにしたいです
    次に張り付けると6から始まります

    分かりにくくてすみません

    「Excelで、特定セルに張り付けると特定」の補足画像1
    No.3の回答に寄せられた補足コメントです。 補足日時:2021/06/10 18:14
  • ありがとうございます。
    説明不足ですみません

    必ず同じ数字が15個並ぶのではなく、15行以上あるときに
    15行毎に+1
    61行貼り付けたとすると
    1~15行は今まで通り、16~30行目は15行目の数字に+1
    31~45行は、30行目の数字に+1
    46~60行は、45行目の数字に+1

    となる様にしたいです

    「Excelで、特定セルに張り付けると特定」の補足画像2
    No.4の回答に寄せられた補足コメントです。 補足日時:2021/06/10 20:22
  • 最初の画像は、説明用でした
    ごめんなさい
    K5からデータが入力されます

      補足日時:2021/06/10 20:49
  • 遅くまでありがとうございます。

    新しくファイルにコードを入力して実行してみました
    思い通りに動いてくれました。実際に使用しているファイルに
    コードをいれて動かしてみるとエラーとなってしまします。
    なぜだか分かりません
    エラー画像添付します

    「Excelで、特定セルに張り付けると特定」の補足画像4
    No.5の回答に寄せられた補足コメントです。 補足日時:2021/06/11 06:15
  • 貴重な時間対応して頂きありがとうございます

    色々試してみました

    回答5で回答頂いたコードで動作したのですが、
    別ファイル(Aとします)からデーターをコピーして、ファイル(Bとします)貼り付けているのですが
    ※Bファイルの今回コードを入れています。
    Bファイルで、例えば手入力でD行に入力するとK行に数字が入ります。
    入力した内容を取り消したりすると次に貼り付けると13エラーがでます。
    ※貼り付けは、マクロで行っています(Aファイルの内容をコピーしてBファイルに
    貼り付けるマクロです)
    ※特にファイルを触らずに動作せれば思い通りの動作です
    一度エラーが出ると貼り付けつたびに13エラーが出でしまい何度繰り返してもダメです
    なぜなのかわかりません

    No.6の回答に寄せられた補足コメントです。 補足日時:2021/06/12 07:36
gooドクター

A 回答 (7件)

エラーの想定できる原因、回避のヒントは#6に書いた通りですが、


仕様が解らないので実際にどのようにすれば良いか、、
ファイルをどのように弄っているのか、、、
表中の値を削除や書き直しなどされるのかとか、、K列のみ手入力で値を操作(文字、関数 入力や空白など)したりするとか

>入力した内容を取り消したりすると次に貼り付けると13エラーがでます。
エラーが出る時のセルの値は何でしょう?
ブレイクポイントを設けるとかイミディエイトウィンドウで確認するとかしてデバッグしましょう。

今までのコードで問題が発生していないのなら
no = Range("K" & Cells(Rows.Count, "K").End(xlUp).Row).Value + 1
に書き替えればエラー箇所まで同じになると思いますが、、

ご質問部分以外を変えたのが悪かったのかも知れません。
If Target.Row = 1 なども気になるのでもう一度全部で考えて
K列該当セルの値が数値でなければ+1されないようにしたものです
+1にする必要がある場合は、さらに上行方向に値が数値のセルまで
ループして探すとかになると思います。
表中の行の場合、K列一番下の数値に出来る行が+1対象です。
そのセルの値が数値に出来ない値の場合、+1されません。(1が入る)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, no As Long: no = 1
Dim Rng As Range
If Target.Row < 5 Or Target.Column <> 4 Then Exit Sub
If Range("K5").Value <> "" Then
Set Rng = Range("K" & Cells(Rows.Count, "K").End(xlUp).Row)
If IsNumeric(Rng) Then
no = Rng.Value + 1
End If
End If
Application.EnableEvents = False
For i = 1 To Target.Count
If Target(i).Value = "" Then
Target(i).Offset(0, 7).ClearContents
Else
If i > 1 And Int(i - 1) Mod 15 = 0 Then no = no + 1
Target(i).Offset(0, 7).Value = no
End If
Next i
Application.EnableEvents = True
End Sub
    • good
    • 0
この回答へのお礼

エラーも出ず、思い通りに動いてくれました


ありがとうございます。
丁寧に対応して頂き感謝しております。



ありがとうございました(^^♪

お礼日時:2021/06/12 10:40

こんにちは


13エラーですか、考えられるのは+1をしようとしているセルの値が
""だったり文字など四則演算出来ないケースだと思うのですが、
K列の下の方に関数式や文字入力の残りなど無いですか?

ちなみに
no = Range("K" & Cells(Rows.Count, "K").End(xlUp).Row).Value + 1
でもエラーになると思うのですが、、
違う原因だったらごめんなさい。

想定対応としてK列のTarget行から下を一度クリアーするなど、、
いや、ちょっと雑な気がします
数値が入っている事を検証して+1するとか、、数値でなければ
更にそのセルから.End(xlUp)・・

VBAで上行から数値が振られていく処理ならば、(空白行が出来ないのなら)
考え方を変えて 下記の様にするとどうでしょう。
仕様に合わなくなるようでしたら、検討が必要ですが

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, no As Long: no = 1
If Target.Row = 1 Or Target.Column <> 4 Then Exit Sub
If Range("K5").Value <> "" Then
no = Range("K5").End(xlDown).Value + 1
End If
Application.EnableEvents = False
For i = 1 To Target.Count
If Target(i).Value = "" Then
Target(i).Offset(0, 7).Value = ""
Else
If i > 1 And Int(i - 1) Mod 15 = 0 Then no = no + 1
Target(i).Offset(0, 7).Value = no
End If
Next i
Application.EnableEvents = True
End Sub
この回答への補足あり
    • good
    • 0

こんばんは、


思っていたのと大分違っていたようで、、
For Each rng In Target からのrng相対位置を取得する方法が、、どうだったか、
ちょっと思考放棄をしてループを変えてしまいました。
お好みでないかも知れませんが、上記(思考放棄部分)を調べてみてください。

処理自体は、こんな感じで良さそうですが、どうでしょう。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim no As Long
Dim i As Long
If Target.Row = 1 Or Target.Column <> 4 Then Exit Sub
If Range("K5").Value = "" Then
no = 1
Else
no = Cells(Rows.Count, "K").End(xlUp).Value + 1
End If
Application.EnableEvents = False
For i = 1 To Target.Count
If Target(i).Value = "" Then
Target(i).Offset(0, 7).Value = ""
Else
If i > 1 And Int(i - 1) Mod 15 = 0 Then
no = no + 1
End If
Target(i).Offset(0, 7).Value = no
End If
Next i
Application.EnableEvents = True
End Sub

ちょっと、酔いが、、違っていたら
Else
If i > 1 And Int(i - 1) Mod 15 = 0 Then
no = no + 1
End If
Target(i).Offset(0, 7).Value = no
End If
の部分だと思いますので考えてくださいね。
この回答への補足あり
    • good
    • 0

連投失礼します。


補足ありがとうございます
画像を見るとご質問に示されているコード処理と結果が違うと思うのですが、
If Range("K5").Value = "" Then
no = 1
2度目の貼り付け(青)の時 K5は””ですよね。
なので 1となるのではないでしょうか?Else の
no = Range("K" & Cells(Rows.Count, "K").End(xlUp).Row).Value + 1
は、実行されないと思いますが、いかがでしょう?
If Range("K4").Value = ""と変えてみては?
いずれにしても、
回答は、15行より上の処理は触っていません。

ただ、やはりなさりたい事を理解できていなかったと言う事のようですね

>61行貼り付けたとすると1~15行は今まで通り

16行目以降はすでに示した通りですが、2行目から15行目は
一度にペーストするとすべてに1が入るコードになっていると思うのですが
61行をペーストした時に2行目から15行目はどのようになるのですか?
コードからしか判断できませんので、期待する結果を教えてください。

16行目以降の処理結果は  31~45行は、30行目の数字に+1などと
同じだと思いますので
16~30行目は15行目の数字に+1
31~45行は、15行目の数字に+2
46~60行は、15行目の数字に+3
と言う考え方です。

一応、プロシージャを(画像も)ご確認ください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim no As Long
Dim rng As Range
If Target.Row = 1 Or Target.Column <> 4 Then Exit Sub
If Range("K4").Value = "" Then
no = 1
Else
no = Range("K" & Cells(Rows.Count, "K").End(xlUp).Row).Value + 1
End If
Application.EnableEvents = False
For Each rng In Target
If rng.Value = "" Then
rng.Offset(0, 7).Value = ""
Else
If rng.Row > 15 Then
no = Int((rng.Row - 1) / 15)
rng.Offset(0, 7).Value = no + Range("K15").Value
Else
rng.Offset(0, 7).Value = no
End If
End If
Next rng
Application.EnableEvents = True
End Sub
「Excelで、特定セルに張り付けると特定」の回答画像4
この回答への補足あり
    • good
    • 0

#2


例として挙げましたが
no = Application.RoundUp(rng.Row / 15 - 1, 0)
整数部分を作るより、よく使うのはこちらかも、、整数部分を取り出す
no = Int((rng.Row - 1) / 15)
-1は16行目からなので
この回答への補足あり
    • good
    • 0

こんにちは


>1~15行は今まで通り、16~30行目は15行目の数字に+1
31~45行は、30行目の数字に+1
46~60行は、45行目の数字に+1 その後も15行ごとに+1

説明と少し違うような気がしますが思い違いと思うので

16行目以降の処理は 例として

If rng.Value = "" Then
rng.Offset(0, 7).Value = ""
Else
If rng.Row > 15 Then
no = Application.RoundUp(rng.Row / 15 - 1, 0)
rng.Offset(0, 7).Value = no + Range("K15").Value
Else
rng.Offset(0, 7).Value = no
End If
End If
Next rng

ご質問を取り違えているかも知れませんが、こんな感じでどうでしょう。
    • good
    • 0

offset(0,15)を使えないかな?

    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング