エクセルvbaプログラムについての質問です。

次のようなプログラムを数行分つくり、一応目的の結果は得られているのですが、500行まで作る予定でこのプログラムを繰り返し作っていくのは大変な作業量になるのでこのまま続けるのを躊躇しています。for~nextを使えばいいのだろうと試みたのですがエラーがでてうまくいきません。
行は aa1:bz1~aa500:bz500
列は m1:q1~m5:q5
500×5=2500個のプログラムを手作業ですることはちょっと気が進みません。スマートにする方法をどなたか教えてください

Sheets("○○").Select
Range("aa1:bz1").SpecialCells(xlCellTypeBlanks)(1, 1).Select

Sheets("××").Select
Range("m1").Select
Selection.Copy
Sheets("○○").Select
ActiveSheet.Paste

以下n1からq1まで同様。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2009/05/20 22:34:02
  • 終了:2009/05/23 07:38:07

回答(2件)

id:kn1967 No.1

kn1967回答回数2915ベストアンサー獲得回数3012009/05/21 00:01:24

ポイント10pt

question:1241597180 でも回答させていただいたとおり

SpecialCells(xlCellTypeBlanks) では指定された範囲内にブランクセルが無ければエラーになります。

また、一度も使われていない範囲のセルもエラー対象となります。


対応としては

Sub Macro1()
  On Error GoTo error_check: 'エラートラップ設定
  
  ' 貴殿の作ったループするプログラムはここに入る。

  Exit Sub: '正常終了時はここでルーチン終了

error_check: 'エラートラップ(該当するセルが見つかりません。ならば無視して続けさせる)
  If Err.Number = 1004 Then On Error Resume Next
End Sub

といった具合にエラー1004(該当するセルが見つかりません。)が発生しても

強制的に先に進ませるような工夫が必要になります。


ただし、エラー制御は「想定外のエラー(想定外ですから、何が起こるか判りません)」まで

スルーして動作を続けてしまう可能性があるためあまりお勧めは出来ません。


では、どうすれば良いのか・・・。

Range("aa1:ca1").SpecialCells(xlCellTypeBlanks)(1, 1).Select

といった具合に一列多めにしてやります。

当然ながら列CAは全て空白である必要がありますし、

一度でも何らかの値が入っていないと、これまたエラーとなりますので

一度だけ CA500(CA列全部でなくて良いです。一番右下だけでOKです) に値を書き込んで

直ぐに消すという事をやっておきましょう。


もしも、CA列(79列目)にまで何かが貼り付けられてしまうという可能性があるのならば

If Range("aa1:ca1").SpecialCells(xlCellTypeBlanks)(1, 1).Column < 79 Then

などといった回避策もこうじておく必要があるでしょう。


具体的なコードも書けなくはないのですが

>列は m1:q1~m5:q5

に対して

>n1からq1まで同様

だけしか書いておられないので、m2:q2~m5:q5 はどう扱ってよいものやら判らず

とりあえずヒントだけとさせていただきます。

質問文の字数制限により削られたのでしょうけど、失敗されたVBAコードを

コメント欄にでも書いてみてはどうでしょうか?

(誰かがそのものズバリのコードを書いてくれるかもしれません。)


http://q.hatena.ne.jp/answer

id:nekoume

丁寧な回答ありがとうございました。

私はVBAについては、まだ初学者ですので残念ながら回答文でわからないところが多く現状ではついていけないのが実情です。

もう少しレベルを上げて理解できるようにしたいと思っています。

2009/05/23 07:37:29
id:airplant No.2

airplant回答回数220ベストアンサー獲得回数492009/05/21 02:37:07

ポイント60pt

for文で回せば大丈夫です。

サンプルを掲載しておきます。

Option Explicit

Sub PasteCells()
    
    Dim oRng As Range
    Dim oSrcRngs As Range
    Dim i As Integer
    
    For i = 1 To 500
        Sheets("××").Select
        Set oSrcRngs = Range(Cells(i, "m"), Cells(i, "q"))
        Sheets("○○").Select
        For Each oRng In oSrcRngs
            oRng.Copy
            ActiveSheet.Paste (Range(Cells(i, "aa"), Cells(i, "bz")) _
                .SpecialCells(xlCellTypeBlanks)(1, 1))
        Next
    Next
End Sub

★注意

>行は aa1:bz1~aa500:bz500

>列は m1:q1~m5:q5

 多分m1:q1~m500:q500をaa1:bz1~aa500:bz500の空白箇所にペーストしていきたいという意図と思い、作成しました。


ブランクセルが十分にないなどのエラーチェックはしていません。m1~q1の5個が必ずaa1:bz1に入る仮定です。

なお、既にご存知と思いますが、xlCellTypeBlanksは曲者で、利用範囲が矩形で自動検出され、その中のブランクセルのみが選択されます。

エラーを起こした場合は、「編集」→「ジャンプ」→「セル選択」→「空白セル(ラジオボタン)」にて、ブランクセルがあるかどうか確認ください。

http://www.google.co.jp <dummy>

id:nekoume

早速の回答ありがとうございます。

質問が舌足らずの感が否めないのにもかかわらず、よく質問の意図を理解していただいて、望みどおりのプログラムとなっています。

私はVBAについてはまだ初学者なので、回答を見てなるほどと思うところが多々ありました。

2009/05/23 07:37:35

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません