人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセル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まで同様。

●質問者: nekoume
●カテゴリ:コンピュータ
✍キーワード:M1 NeXT SELECT VBA エクセル
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● kn1967
●10ポイント

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

◎質問者からの返答

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

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

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


2 ● airplant
●60ポイント

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>

◎質問者からの返答

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

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

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ