VBA 400エラー 1004エラー

以下のVBAはセルのカット&ペーストをしたり、置換をするプログラムです。
しかし、EXCEL2003であれば通常に動作するのですが、
EXCEL2000だと400エラーや1004エラーが出てしまいます。
原因を探求するもよく分からなかったため、ご教示いただけば幸いです。

Sub 一ページ17名標準()


Application.ScreenUpdating = False

ActiveSheet.Unprotect

Range("A1").Select
Cells.Find(What:="No.2").Offset(-1, 36).Resize(3, 8).Insert Shift:=xlDown
Cells.Find(What:="No.2").Offset(-1, 2).Resize(3, 1).EntireRow.Delete
Rows("2:61").RowHeight = 21.75 '''行の幅　変更点
Cells.Find(What:="No.1").Offset(-1, 2).Resize(3, 1).EntireRow.Copy
Range("38:38").Insert '''No2見出し挿入カ所　変更点
Range("A39").Replace What:="No.1", Replacement:="No.2" '''No1→No2置換カ所　変更点
Cells.Find(What:="No.2").Offset(-1, 36).Resize(3, 8).Delete Shift:=xlUp

Cells.Find(What:="♯管理欄").Resize(3, 8).Activate ' ' '名字のエクセル関数の調整(全共通)
Selection.Cut
Range("AK63").Select
Selection.Insert Shift:=xlDown
Cells.Find(What:="♯管理欄").Resize(3, 8).Activate
Selection.Cut
Range("AK38:AS40").Select
Selection.Insert Shift:=xlDown
Range("A1").Select


ActiveSheet.Protect

Application.ScreenUpdating = True

End Sub

宜しくお願いします。

No.3 ベストアンサー 回答者： cj_mover 回答日時： 2012/10/12 13:32

こんにちは。

＃１、ｃｊです。
こちらのスタンスとしては、どこに問題があるのかを、まず、ひとつひとつ確かめて
ひとつひとつの問題点を明らかにして、ひとつひとつ手当てするというものです。
何故ならば、このスレは今のところ、質問者さんが提示したコードを動くようにする
ということが、優先事項だからです。
動くようなコードを提示してほしい、とか、正しい記述を教えてほしいというものではありません
ので自重していたのですけれど。
＃２さんがご指摘の点も、こちらでは把握していますし、提示する準備はしてありましたが、
どうなんでしょう。却って混乱するようなことにならなければいいのですが。

Sub 一ページ17名標準4debug() 'okg7737673 7743252
Dim oRng As Range
Dim nL As Integer
On Error GoTo errT_

'Application.ScreenUpdating = False

With Sheets("Sheet1")
' .Unprotect

' Cells.Find(What:="No.2").Offset(-1, 36).Resize(3, 8).Insert Shift:=xlDown
' Cells.Find(What:="No.2").Offset(-1, 2).Resize(3, 1).EntireRow.Delete
1 Set oRng = .UsedRange.Find(What:="No.2", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False)
If oRng Is Nothing Then
MsgBox "not Found @1" & vbLf & "No.2　が見つかりません"
Exit Sub
Else
nL = 11
oRng.Offset(-1, 36).Resize(3, 8).Insert Shift:=xlDown
nL = 12
oRng.Offset(-1, 2).Resize(3, 1).EntireRow.Delete
End If

nL = 19
.Rows("2:61").RowHeight = 21.75 '''行の幅　変更点

' Cells.Find(What:="No.1").Offset(-1, 2).Resize(3, 1).EntireRow.Copy
2 Set oRng = .UsedRange.Find(What:="No.1")
If oRng Is Nothing Then
MsgBox "not Found @2" & vbLf & "No.1　が見つかりません"
Exit Sub
Else
nL = 21
oRng.Offset(-1, 2).Resize(3, 1).EntireRow.Copy
End If

nL = 28
.Range("38:38").Insert '''No2見出し挿入カ所　変更点

nL = 29
.Range("A39").Replace What:="No.1", Replacement:="No.2" '''No1→No2置換カ所　変更点

' Cells.Find(What:="No.2").Offset(-1, 36).Resize(3, 8).Delete Shift:=xlUp
3 Set oRng = .UsedRange.Find(What:="No.2")
If oRng Is Nothing Then
MsgBox "not Found @3" & vbLf & "No.2　が見つかりません"
Exit Sub
Else
nL = 31
oRng.Offset(-1, 36).Resize(3, 8).Delete Shift:=xlUp
End If

' Cells.Find(What:="♯管理欄").Resize(3, 8).Cut ' ' '名字のエクセル関数の調整(全共通)
4 Set oRng = .UsedRange.Find(What:="♯管理欄")
If oRng Is Nothing Then
MsgBox "not Found @4" & vbLf & "♯管理欄　が見つかりません"
Exit Sub
Else
nL = 41
oRng.Resize(3, 8).Cut
End If

nL = 49
.Range("AK63").Insert Shift:=xlDown

' Cells.Find(What:="♯管理欄").Resize(3, 8).Cut
5 Set oRng = .UsedRange.Find(What:="♯管理欄")
If oRng Is Nothing Then
MsgBox "not Found @5" & vbLf & "♯管理欄　が見つかりません"
Exit Sub
Else
nL = 51
oRng.Resize(3, 8).Cut
End If

.Range("AK38:AS40").Insert Shift:=xlDown
.Range("A1").Select


' .Protect
End With
'Application.ScreenUpdating = True
Set oRng = Nothing
Exit Sub
errT_:
Set oRng = Nothing
MsgBox nL & vbLf & "番号を控えて知らせてください"
End Sub

つまるところ、何をやりたいのか、ひいては、何を持って解決なのか
把握しようがないのです。
どの行でエラーが出るのか、という情報さえ、リクエストしたのにもらえないので、、、。
もう少し、手掛かりが、欲しいと考えて、昨日の時点で上のコードを書いてはいたのですが、
これを試して、どうなるか、フィードバックはもらえるのでしょうか？
実際のシートが見えませんから、こちらでは、ダミーのサンプルを既に１０種類ほど作成して
求める結果の想定解を予測したりしましたが、やはり見えてこない、というか、気の遠くなるような
作業です。
喩えれば、ピースの足りないジグソーパズルを渡されて、
間違ったピースを混ぜられて、元の絵を再現せよ、と言われているようなもので。

私の優先度としては、２番目に確認するべきことは
＞Cells.Find(What:="No.2").Offset(-1, 2).Resize(3, 1).EntireRow.Delete
この行の記述で何をしたいのか？ということの確認です。
Cells.Find(What:="No.2")で見つけた"No.2"セルを削除していますから、
もし、このほかに"No.2"と書かれたセルが無いならば、
その後でCells.Find(What:="No.2")が出てくる度にエラーになります。

最後に、
もっと、具体的なレスがないと対応できません。今までのようなやりとりでは
解決は数か月先になるでしょう。
こちらが必要だという情報が得られなければ継続は困難です。
代わりにきちんと動くものを提示せよ、という風に話が変わっていったとしても
なにがやりたいか説明抜きではむり無理でしょう。
＃２さんなら、このままでも解決できる、ということなら、
そちらを優先してくださって結構です。快く引き下がりますので。
ちょっと、何を優先させるべきなのか、私にもわからなくなっていたところなので。

No.2 回答者： WindFaller 回答日時： 2012/10/12 12:18

Excel2003とか、2000とか関係がなく、エラーが出て当然だと思います。

Cells.Find(What:="No.2").Offset(-1, 36).Resize(3, 8).Insert Shift:=xlDown

こんな乱暴な書き方は直したほうがよいですね。

絶対に、"No.2" があるという前提で作られていますが、それは事情によって変わるはずです。一度、変数で受けて、その変数が確保されたか確認して、それで、処理をするって、基本だと思います。

Set r = Cells.Find(What:="No.2")
If Not r Is Nothing Then
　　r.Offset(-1, 36).Resize(3, 8).Insert Shift:=xlDown
End If

それから、ExcelのFindメソッドは、省略すると規定どおりに動くはずです。規定とは、Excelのワークシート側で設定しないと、そのまま、設定されている状態です。(私の記憶だけで、確かめていません)

後は、Offset のパラメータにマイナスを入れているようですが、それは、安全だとみなします。

それと、
Range("A1").Select
は、画面の見栄えのためだから、Select はいらないにしても、それは製作者任意で残してよいです。

>Selection.Cut
ここは、Excel2000とExcel2003のバージョンによって、挙動が違うことがありますから、2つのバージョンを同じマクロで使う時は、Cut を使わずに、手順通り、Copy して、貼り付けて、そして、元の場所を、消す(Clear) をしましょう。

>ためしにＳｅｌｅｃｔ，Ｓｅｌｅｃｔｉｏｎを含むをすべて削除したところ、エラーがでなくなりました。

後は、Select の合った場所に、Selection の次の命令を繋げばよいだけです。

>Range("AK38:AS40").Select
>Selection.Insert Shift:=xlDown
　　↓
Range("AK38:AS40").Insert Shift:=xlDown

まず、最初の基本的な所を直さないといけません。

No.1 回答者： cj_mover 回答日時： 2012/10/09 00:21

こんにちは。

その現象は、たぶん、バージョンの問題ではなくて、
Findメソッドの使い方が正しくない、という結果であろうと思われます。
どんなことを やりたい のか文章での説明がなく、
提示されたコードも肝心なところが省略されてしまっているので、
適切なアドバイスはしようがありません。
可能性が高そうなものについて、説明するしかできませんので、
違っていたら、すみません。

以下ＶＢＡヘルプ「Range.Find」より抜粋（改行は筆者）」　　
｜　引数 LookIn、LookAt、SearchOrder、および MatchByte の設定は、このメソッドを使用するたびに保存されます。
｜　次にこのメソッドを使用するときにこれらの引数の指定を省略すると、保存された設定が使用されます。
｜　これらの引数の設定を変更すると、[検索と置換] ダイアログ ボックスに表示される設定が変わります。
｜　また、[検索と置換] ダイアログ ボックスで設定を変更すると、
｜　保存されている値、つまり引数を省略した場合に使用される値が変わります。
｜　このような設定の変更によって生じる問題を避けるには、メソッドを使用するたびに、これらの引数を明示的に指定します。
以上

やりたいこと の邪魔になりそうなポイントは LookAt、MatchByte の指定ミス。なのではないかと。

LookAt
　"As No.1"
　"No.1 Writer"
など部分一致を検索対象にする場合は
　LookAt:=xlPart
そうではなくて
　"No.1"
だけをヒットさせたいなら
　Lookat:=xlWhole

MatchByte
　"No.2"
　"No.２"
　"Ｎｏ．２"
　"Ｎｏ.２"
など、全角｜半角を問わずすべてヒットさせたいなら
　MatchByte:=False
そうではなくて
　"No.2"
全角なのか半角なのか正確に一致するものだけをヒットさせたいなら
　MatchByte:=True

省略してはいけないものを省略していますから、期待通りの結果が得られないのでしょう。
仮に今回のご質問が、他の原因であったとしても、省略できないものはできません。

解決策として、"部分一致""全半角を区別しない"場合の例

＞　Cells.Find(What:="No.2").Offset(-1, 36).Resize(3, 8).Insert Shift:=xlDown

この↑　行　を　以下の一行　に　書き換えます。

Cells.Find(What:="No.2", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Offset(-1, 36).Resize(3, 8).Insert Shift:=xlDown

上の解説を参考に実際にやりたいことに合わせてそちらで応用してください。

それでも改善されない場合は、ご提示のコードのどの行でエラーになったのか、
せめて、それ位の情報がないと解決は遠くなると思います。

言いにくいことですが、ご提示のコードは標準的な記法と比べると非常に読み難いものになっています。
今後もこのコードのメンテナンスに関する質問をすることもあるでしょうから、
その時は、コードではなく文章で やりたいこと を示せるように努めた方が解決が得易いと思いますし、
また、より良い方法を積極的に提案するような回答にも出会えるようになると思います。
次があった時のために記憶の隅にでも置いておいてください。

この回答へのお礼

ご回答ありがとうございます。ご指摘の通りに応用させていただいたのですが、同内容のエラーが出てしまいます。ためしにＳｅｌｅｃｔ，Ｓｅｌｅｃｔｉｏｎを含むをすべて削除したところ、エラーがでなくなりました。そこで、ワークシートを指定するよう記載してみましたが、技術不足で書くことが出来ません。何卒ご教示いただければと存じます。

お礼日時：2012/10/11 13:17