セルが空白だったらExitSub

質問

いつもお世話になっております。
問う方Excel97でシートAのD列のデータを
シートBに自動コピーさせるVBAを思考中。
D列のデータが無くなったらLoopを止めるように
条件をつけたいのですが、どう書いたものか困っております。
ちなみに、セルの指定もコピーを書きこんだら次の行を見に行かせる為に、引数？を使用しています。
どなたか、教えて下さい。
宜しくお願い致します。

回答No.1

BlueRay · ベストアンサー

あまりにも簡潔すぎて私には理解が難しいですが、
以下のようにすれば出来ますけど。

解説：
ループでやっているということなので、以下のようになります。
Dim lIdx as long '行ループ変数
Dim lTargetCol as long '指定列

lIdx = 1
lTargetCol = 4 'D列を指定
Do
　　If Cells(lIdx, lTargetCol).value = "" Then Exit Sub

　　'ココに何か処理が入ります。

　　lIdx = lIdx + 1
Loop

Do～Loopのところはこうでもいいです。

Do Until Cells(lIdx, lTargetCol).value = ""

　　'ココに何か処理が入ります。

　　lIdx = lIdx + 1
Loop

お礼

ご回答、ありがとうございました。

私が作成したかったのは下記がやりたかったからなんです。
先にchkをtrueにしておき、

Do While chk = True
'*処理内容
If Cells(lIdx, 4).Value = "" Then
chk = False
End If

lIdx = lIdx + 1
Loop

↑で処理をします。

本当に助かりました。
ありがとうございます。

回答No.2

nishi6

データの性格が不明なため、最終登録行を求めるようにしてみました。
データの途中に未登録行があっても構いません。
最下行(Excel97以降は65536行目)から上方向に最終登録行を調べたほうが汎用的でしょう。
後は For～Next でまわせます。

個人的にはセル単位で書くのは余り行いません。時間がかかるし・・・
　CopyTest2はセル範囲をコピーしています。
　CopyTest3は列を丸ごとコピーしていいならLoopの必要はなくなります。

後、
　Endプロパティ、
　CurrentRegionプロパティ、
　SpecialCellsメソッド、
　UsedRangeプロパティ、
　Resizeプロパティ
などはセル操作を効果的にすることができます。Helpにあります。ご参考に。

'セル単位でコピー
Sub CopyTest1()
　　Dim rw As Long '行カウンタ
　　Dim col As Integer '列カウンタ

　　With Worksheets("A")
　　　　'D、E列をコピーする(Cells(行数,列数)でD列=4、E列=5)
　　　　For col = 4 To 5
　　　　　　'各列で入力された最後のセルの行を求める
　　　　　　'Cells(65536, col)は一番下のセル。上方向に入力された最後のセルを求める
　　　　　　'開始行は１行目にしてある
　　　　　　For rw = 1 To .Cells(65536, col).End(xlUp).Row
　　　　　　　　'コピーの例。同じセル番地にコピーしている
　　　　　　　　Worksheets("B").Cells(rw, col) = .Cells(rw, col)
　　　　　　Next
　　　　Next
　　End With
End Sub

'セル範囲をコピー
Sub CopyTest2()
　　With Worksheets("A")
　　　　.Range("D1:D" & .Range("D65536").End(xlUp).Row).Copy Destination:=Worksheets("B").Range("D1")
　　End With
End Sub

'行を丸ごとコピーしていいなら・・・
Sub CopyTest3()
　　Worksheets("A").Range("D:D").Copy Destination:=Worksheets("B").Range("D:D")
End Sub

お礼

ご回答、ありがとうございました。

私が作成したかったのは下記がやりたかったからなんです。
先にchkをtrueにしておき、
データが無くなったらLoopを抜けるというのが
作りたかったんです。

Do While chk = True
'*処理内容
If Cells(lIdx, 4).Value = "" Then
chk = False
End If

lIdx = lIdx + 1
Loop

勉強になりました。
ありがとうございました。