Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6840 / 13646 ツリー ←次へ | 前へ→

【42807】連続する2つの行が空白だった場合に処理... 氷室 06/9/22(金) 15:09 質問[未読]
【42808】Re:連続する2つの行が空白だった場合に処理... ハチ 06/9/22(金) 15:16 回答[未読]
【42810】Re:連続する2つの行が空白だった場合に処... 氷室 06/9/22(金) 15:34 お礼[未読]

【42807】連続する2つの行が空白だった場合に処理...
質問  氷室  - 06/9/22(金) 15:09 -

引用なし
パスワード
   氷室と申します、
前回「特定文字間の列の非表示について 」
では多くの回答どうもありがとうございました。

再び未解決な部分が出来てしまったので
質問させていただきます。


シートを2枚持つExcelがあります。(下図)

(Sheet1)
--------------------
 項目1  | 項目2   ・・・・
--------------------
A氏    |AAAAA軍
B氏    |AAAAA軍
(Null)   |(Null)
D氏    |DDDDDDD軍
(Null)   |(Null)   ←★1
F氏    |FFFFFF軍
G氏    |FFFFFF軍
H氏    |FFFFFF軍
(Null)   |(Null)
(Null)   |(Null)   ←★2
-------------------

(Sheet2)
--------------------
 項目1  | 項目2   ・・・・
--------------------
       |
-------------------

シート1は項目1と項目2の2つがあります。
(他にも数十列項目はあるのですが、ここでは2項目で話ます。)

シート1に(Null)があるのは空白行です。
項目2で同じグループ分けしているものを見やすくするために
一行Null行が入っています。
※一行以上空いた下にデータが入ることは無しとします。
  つまり、2行空白行が出来た場合にはそこが終端と考えます。

シート2は始め、何も書かれていません。

処理はシート1からをシート2にコピーします。
コピーする部分はできていて、問題なく動作します。
現状ではコピーする時に、空白行があると
その時点で処理を終了する仕様になっていました。
これを、2行連続して空白が出来た場合に処理を終了したいのです。

そこで、
空白行ができるとカウントし、
2行になったら終わる様にしようと考えたのですが
そうすると、Sheet1の図で★1の部分で終了してしまいます。
希望としては★2の部分までコピーしたいです。

途中の空白行はそのままシート2にもコピーします。

コードは以下です。
単純に空白だったらカウントしているだけなので
★1でループから抜けてしまうと思うのですが、
cntNAME >= 1だと、1行空白があるだけで抜けるので
現状と変わりません。

連続する2つの行が空白だった場合に処理を終了する。
という作りにしたいのでどなたかよろしくお願いします。

(コード)
-----------------
dim cntNAME as integer

Do While Not cntNAME >= 2
  If Sheet1.Cells(intRow, 3) = "" Then '空白かどうかチェック。
    cntNAME = cntNAME + 1       '空白であればカウント。
  End If
 ★コピーする処理。(1行ずつコピー)
Loop
-----------------

【42808】Re:連続する2つの行が空白だった場合に処...
回答  ハチ  - 06/9/22(金) 15:16 -

引用なし
パスワード
   ▼氷室 さん:

>そこで、
>空白行ができるとカウントし、
>2行になったら終わる様にしようと考えたのですが
>そうすると、Sheet1の図で★1の部分で終了してしまいます。
>希望としては★2の部分までコピーしたいです。
>
>途中の空白行はそのままシート2にもコピーします。
>
>コードは以下です。
>単純に空白だったらカウントしているだけなので
>★1でループから抜けてしまうと思うのですが、
>cntNAME >= 1だと、1行空白があるだけで抜けるので
>現状と変わりません。
>
>連続する2つの行が空白だった場合に処理を終了する。
>という作りにしたいのでどなたかよろしくお願いします。
>
>(コード)
>-----------------
>dim cntNAME as integer
>
>Do While Not cntNAME >= 2
>  If Sheet1.Cells(intRow, 3) = "" Then '空白かどうかチェック。
>    cntNAME = cntNAME + 1       '空白であればカウント。
  Else
    cntNAME = 0
>  End If

> ★コピーする処理。(1行ずつコピー)
>Loop
>-----------------

で良いのでは?

【42810】Re:連続する2つの行が空白だった場合に処...
お礼  氷室  - 06/9/22(金) 15:34 -

引用なし
パスワード
   ▼ハチ さん:
>>(コード)
>>-----------------
>>dim cntNAME as integer
>>
>>Do While Not cntNAME >= 2
>>  If Sheet1.Cells(intRow, 3) = "" Then '空白かどうかチェック。
>>    cntNAME = cntNAME + 1       '空白であればカウント。
>  Else
>    cntNAME = 0
>>  End If
>
>> ★コピーする処理。(1行ずつコピー)
>>Loop
>>-----------------
>
>で良いのでは?

早速の回答ありがとうございます。
深く考え過ぎてしまっていました、おっしゃるとおり、
cntNAME = 0の追加で思う通りに動きました。

思いの外簡単な記述で解決できた事に
ちょっと開いた口がふさがりませんでしたが;助かりました。

【解決しました、ありがとうございました。】

6840 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free