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

VBAで一定間隔ごとに決まった行を削除するマクロを教えてください。

テキストファイルからデータをエクセルに取り込んだ後、不要な行を削除して
データ処理をしたいと考えています。
具体的には、30行おきに6行削除する処理をファイルの最後まで繰返したいです。
削除する行には空白行も含め何かしらのデータが含まれています。
また、空白行だけを削除する方法についてもご教示ください。
宜しくお願いします。




●質問者: buri0624
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● a-kuma3
●200ポイント ベストアンサー

テキストファイルから読み込むときにデータを削除してから Excel のシートに貼り付けるとしたら、こんな感じで。

Sub readdata_30line()
 On Error GoTo ErrorHandler

 Const inputFile = "D:\tmp\input.txt"  ' 読み込むファイル

 Application.ScreenUpdating = False

 r = 1
 Open inputFile For Input As #1
 Do Until EOF(1)
 for i = 1 to 30  ' 30行読み込んで、セルへ
 if eof(1) then
 exit for
 end if
 Line Input #1, buf
 Cells(r, 1).Value = buf
 r = r + 1
 next
 for i = 1 to 6  ' 6行読み飛ばす
 if eof(1) then
 exit for
 end if
 Line Input #1, buf
 next
 Loop

FINAL:
 Close #1
 Application.ScreenUpdating = True

 Exit Sub

ErrorHandler:
 GoTo FINAL

End Sub

削除する行には空白行も含め何かしらのデータが含まれています。
また、空白行だけを削除する方法についてもご教示ください。

削除する対象のうち、空行だけを削除するとしたら、こんな感じ。

Sub readdata_30line()
 On Error GoTo ErrorHandler

 Const inputFile = "D:\tmp\input.txt"  ' 読み込むファイル

 Application.ScreenUpdating = False

 r = 1
 Open inputFile For Input As #1
 Do Until EOF(1)
 for i = 1 to 30  ' 30行読み込んで、セルへ
 if eof(1) then
 exit for
 end if
 Line Input #1, buf
 Cells(r, 1).Value = buf
 r = r + 1
 next
 for i = 1 to 6  ' 6行読み飛ばす
 if eof(1) then
 exit for
 end if
 Line Input #1, buf
  ' ★以下の 4行を追加してます
 if buf <> "" then
 Cells(r, 1).Value = buf
 r = r + 1
 endif
 next
 Loop

FINAL:
 Close #1
 Application.ScreenUpdating = True

 Exit Sub

ErrorHandler:
 GoTo FINAL

End Sub




追記です。

テキストを読み込むタイミングでの処理ではなく、一旦テキストの内容を
エクセルに取り込んだ後に、当初質問させて頂いた処理を行う方法も
ご教示いただけませんでしょうか。

まず、6行をまるっと削除する場合です。

Sub extract_30line()
 On Error GoTo ErrorHandler

 Application.ScreenUpdating = False

  ' 最終行を調べる
 last_row = Cells(Rows.Count, 1).End(xlUp).Row

 r = 1
 Do While r <= last_row
 r = r + 30
 Set area = Range(Cells(r, 1), Cells(r + 5, 1))
 area.EntireRow.Delete
 last_row = last_row - 6
 DoEvents
 Loop

FINAL:
 Application.ScreenUpdating = True

 Exit Sub

ErrorHandler:
 GoTo FINAL

End Sub

こちらは、削除対象の6行の中で、空白行だけを削除する場合です。

Sub extract_30line()
 On Error GoTo ErrorHandler

 Application.ScreenUpdating = False

  ' 最終行を調べる
 last_row = Cells(Rows.Count, 1).End(xlUp).Row

 r = 1
 Do While r <= last_row
 r = r + 30
 i = 1
 r = r + 1
 Do While i <= 6
 If WorksheetFunction.CountA(Rows(r)) = 0 Then
 Rows(r).Delete
 last_row = last_row - 1
 Else
 r = r + 1
 End If
 i = i + 1
 Loop
 DoEvents
 Loop

FINAL:
 Application.ScreenUpdating = True

 Exit Sub

ErrorHandler:
 GoTo FINAL

End Sub

処理の対象となる最終行をしらべるのに A列の中で最後にデータが入っている行を使っています。

 last_row = Cells(Rows.Count, 1).End(xlUp).Row

もし、データが入っている列が特定できないのであれば、以下のように書き換えてください。

 last_row = Cells.SpecialCells(xlCellTypeLastCell).Row

こちらのやり方だと、行を削除したり、セルに値を入れて消すとか、書式だけを設定するとか、シートで操作をすると、見た目は空白行でもカウントされるケースがあります。
空のシートにテキストファイルからデータを取り込んですぐにマクロを使うのであれば、こちらの方が確実かもしれません。


a-kuma3さんのコメント
>> テキストを読み込むタイミングでの処理ではなく、一旦テキストの内容を エクセルに取り込んだ後に、当初質問させて頂いた処理を行う方法も ご教示いただけませんでしょうか。 << 回答に追記しました。

質問者から

回答有難うございます。

テキストを読み込むタイミングでの処理ではなく、一旦テキストの内容を
エクセルに取り込んだ後に、当初質問させて頂いた処理を行う方法も
ご教示いただけませんでしょうか。

お手数ですが宜しくお願いします。


関連質問

●質問をもっと探す●



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