Excel VBA .xlsm→.xls変換

質問

VBAマクロの初心者です。
Office2010で作ったプログラムをOffice2000で実行したいのですが、
*.xlsmなら問題なく実行できるプログラムが、*.xlsでは
「エラー1004　アプリケーション定義またはオブジェクト定義のエラーです。」となります。作ったプログラムの詳細は以下の通りです。
*.xlsmで実行した際も、繰り返しが多いせいかどうも遅いので、効率化できる方法がありましたら、併せてご教授いただけると幸いです。
よろしくお願いいたします。

目的：Sheet1にある表AをSheet2にある表Bに変換する。（添付画像参照）
　　　※年月と国名は、あらかじめSheet2に入力してあります。
　　　　また、空白にゼロを入れる作業は省いています。
以下、実行したプログラムです。

Sub paste()
Dim name11
Dim name12
Dim name13
Dim name21
Dim name22
Dim name2k

For i = 2 To 150 'Sheet1の行はiで定義し、2行目から150行目まで繰り返し
For j = 2 To 300 'Sheet2の行はjで定義し、2行目から300行目まで繰り返し

name11 = Worksheets("Sheet1").Cells(i, 1).Value 'Sheet1の"年"
name12 = Worksheets("Sheet1").Cells(i, 2).Value 'Sheet1の"月"
name13 = Worksheets("Sheet1").Cells(i, 3).Value 'Sheet1の"国名"
name21 = Worksheets("Sheet2").Cells(j, 1).Value 'Sheet2の"年"
name22 = Worksheets("Sheet2").Cells(j, 2).Value 'Sheet2の"月"

For k = 3 To 100 'Sheet2の列はkで定義し、3列目から100列目まで繰り返し

name2k = Worksheets("Sheet2").Cells(1, k).Value 'Sheet2の1行目（国名）※*.xlsで実行し、デバッグすると、この行がエラー1004になります。

If (name11 = name21 And name12 = name22 And name13 = name2k) Then
'年と月が一致し、かつSheet1の3列目(国名)とSheet2の1行目（国名）が一致したら

Worksheets("Sheet1").Cells(i, 4).Copy Destination:=Worksheets("Sheet2").Cells(j, k)
'Sheet1のi行4列目の"量"を、Sheet2のj行k列に貼り付ける。
'(j行は正しい年月の横、k列は正しい国名の下。)

Exit For '検索→貼り付けのループを抜けて最初に戻る。
End If
Next
Next
Next
End Sub

回答No.1

puddingeater · ベストアンサー

Office2000は今環境がないのでエラーについては分かりませんので、効率化だけ書きます。
ちなみにExcel2002では質問のコードをそのまま貼り付けて動きました。

年と月が一致する行を見つけてから初めて国名を探すようにしたらループを減らせます。
（下記コード）

これでもなお速度に問題があれば、
・値はすべて2次元配列に編集するようにして、最後に配列の内容を一括でシートに編集する。
・検索処理に Collection オブジェクトや Dictionary オブジェクトを利用する。
といった対処法があります。

Sub paste()
Dim name11
Dim name12
Dim name13
Dim name21
Dim name22
Dim name2k

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim blPasted As Boolean '最初Falseにしておき、量を記入したらTrueにする。

For i = 2 To 150 'Sheet1の行はiで定義し、2行目から150行目まで繰り返し
name11 = Worksheets("Sheet1").Cells(i, 1).Value 'Sheet1の"年"
name12 = Worksheets("Sheet1").Cells(i, 2).Value 'Sheet1の"月"
name13 = Worksheets("Sheet1").Cells(i, 3).Value 'Sheet1の"国名"

For j = 2 To 300 'Sheet2の行はjで定義し、2行目から300行目まで繰り返し

name21 = Worksheets("Sheet2").Cells(j, 1).Value 'Sheet2の"年"
name22 = Worksheets("Sheet2").Cells(j, 2).Value 'Sheet2の"月"

blPasted = False
If (name11 = name21 And name12 = name22) Then
'年と月が一致したら

For k = 3 To 100 'Sheet2の列はkで定義し、3列目から100列目まで繰り返し

name2k = Worksheets("Sheet2").Cells(1, k).Value 'Sheet2の1行目（国名）※*.xlsで実行し、デバッグすると、この行がエラー1004になります。

If (name13 = name2k) Then
'Sheet1の3列目(国名)とSheet2の1行目（国名）が一致したら

Worksheets("Sheet1").Cells(i, 4).Copy Destination:=Worksheets("Sheet2").Cells(j, k)
'Sheet1のi行4列目の"量"を、Sheet2のj行k列に貼り付ける。
'(j行は正しい年月の横、k列は正しい国名の下。)

blPasted = True '量を記入した
Exit For '検索→貼り付けのループを抜けて最初に戻る。
End If
Next
End If

If blPasted = True Then
Exit For '量が記入済みならループを抜ける。
End If
Next
Next
End Sub

お礼

早速の回答ありがとうございます。
教えていただいたコードに直しましたところ、
Excel2000で無事に実行でき、飛躍的に早くなりました。
ありがとうございました。