エクセルで別のシートに連番を入力したい

解決したと思い締め切らせていただいたのですが、
再度問題が出てきたので質問させてください。

http://qanda.rakuten.ne.jp/qa8670339.html


ベストアンサーの方法で運用し始めたのですが、コードを入力したシート(シート名：1)にだけ
エラーが出ます。
2つのセルを一度にペーストしようとすると、(例えば、C11とC12をC13とC14にコピーペースト)
実行時エラー'13':　型が一致しません。とのエラーが出ます。

解決策があれば教えて頂きたく思いますので、よろしくお願いします。

No.3 ベストアンサー 回答者： nishi6 回答日時： 2014/07/12 13:34

前回解答のtom04さんから返事がきたようなので書かせてもらいます。

今度の質問の
＞コードを入力したシート(シート名：1)にだけエラーが出ます。2つのセルを一度にペーストしようとすると、・・・

このエラーの原因は、複数セルを選んで変更処理を行っていて、
　If Target.Address = "$G$7" And Target <> "" Then
のTargetにプロパティが指定されていないからです。

ア．単一セルの場合、VBAがTagetの中身（ValueかText）で判定するのでうまくいきます。
イ．複数セルの場合、Targetという名のRangeオブジェクトに対してTarget <> ""を実行するので「型が一致しません」のエラーが出るわけです。

また、VBAの場合、
　If 判定1 And 判定2　Then
の場合、判定1が成立しない時も判定2を調べに行きます。質問の場合、複数セルを操作しているので「Target.Address = "$G$7"」で弾かれますが、ある意味不必要な「Target <> ""」も実行されて、Rangeオブジェクトと「""」の比較をするので「型が一致しません」のエラーが出るわけです。


さらに、質問には、
＞コードを入力したシート(シート名：1)にだけエラーが出ます。

とありますが、シート1を含む作業グループを作っていて、シート1以外で複数セルを操作するとエラーが出るはずです。また、その状態でシート1以外のセルG7を操作するとシート1のChangeイベントが実行されてしまいます。その動作が期待することかどうかです。本式に作るときにはこの辺りまで気になります。何かが起きた後ではまずいので。


＞解決策があれば教えて頂きたく思いますので、よろしくお願いします。
対応として、
　If Target.Address = "$G$7" And Target <> "" Then
　　　　　　　　　　　　　　　　　　↓
　If Target.Address = "$G$7" And Target.text <> "" Then
　
　ちゃんとプロパティを書くことです。
　
または、
　If Target.Address = "$G$7" Then
　　　If Target <> "" Then
　と意味が異なることをAndで判定しないようにします。この場合はTargetにTextプロパティは必須ではありません。
　
さらに、作業グループを意識する場合は、
　If ActiveSheet.Name = "Sheet1" Then
のような判定を追記します。

この回答へのお礼

お礼が遅くなり申し訳ありません。
提示して頂いた方法でエラーがでなくなりました！
解決にご協力いただきありがとうございました。

お礼日時：2014/07/14 12:59

No.2 回答者： tom04 回答日時： 2014/07/11 21:42

こんばんは！

前回回答した者です。

＞2つのセルを一度にペーストしようとすると、(例えば、C11とC12をC13とC14にコピーペースト)
とありますが、各SheetのC11・C12セルをそのSheetのC13・C14セルにコピーする！というコトでしょうか？

一応そういうコトだとして・・・
前回の「連番」とは意味が違うと思いますので、別のマクロにしてみてはどうでしょうか？
前回はSheet「1」のChangeイベントですので、
Sheet「1」のG7セルデータ変更時にマクロが実行されるコードでした。

標準モジュールに↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを手作業で実行してみてください
（Alt+F8キー　→　マクロ　→　マクロ実行です）

Sub セルコピー()
Dim k As Long
For k = 1 To Worksheets.Count
If IsNumeric(Worksheets(k).Name) Then
With Worksheets(k)
.Range("C11:C12").Copy .Range("C13")
End With
End If
Next k
End Sub

※　今回もSheet名が数字のみのSheetで動作するようにしています。
※　各SheetのC11・C12セルをそのSheetのC13・C14セルにコピー＆ペーストしています。m(_ _)m

この回答へのお礼

何度もお手を煩わせまして申し訳ありません。
なかなか一度で完璧に！とはいかないようですが、今のところ順調に動いております。
いろいろと奥が深いものですね・・・。

お礼日時：2014/07/14 13:02

No.1 回答者： satoron666 回答日時： 2014/07/11 17:33

If Target.Address = "$G$7" And Target <> "" Then

これを見ても、１つのセルをターゲットにしています。

そのプログラムの前に
If Target.Rows.Count <> 1 Then
Exit Sub
End If

と入れてください。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, cnt As Long, str As String, buf As String
If Target.Rows.Count <> 1 Then
Exit Sub
End If

If Target.Address = "$G$7" And Target <> "" Then
For i = 1 To Len(Target)
str = Mid(Target, i, 1)
If str Like "[0-9]" Then Exit For
buf = buf & str
Next i
cnt = Replace(Target, buf, "") + 1
Range("F32") = buf & Format(cnt, "0000")
For k = 3 To Worksheets.Count '★Sheet見出しの３番目のSheet～最終Sheetまで
If IsNumeric(Worksheets(k).Name) Then
cnt = cnt + 1
With Worksheets(k)
.Range("G7") = buf & Format(cnt, "0000")
cnt = cnt + 1
.Range("F32") = buf & Format(cnt, "0000")
End With
End If
Next k

End If
End Sub

こうですね。
少しずつどういった流れでプログラムが動いているのか見てみると良いと思います。

この回答へのお礼

ご回答ありがとうございました。
少しずつ勉強して自分でも解決できるように努力していきます！

お礼日時：2014/07/14 13:03