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


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


回答の条件
  • 1人1回まで
  • 13歳以上
  • 登録:2015/03/12 18:44:14
  • 終了:2015/03/15 22:41:58

ベストアンサー

id:a-kuma3 No.1

a-kuma3回答回数4488ベストアンサー獲得回数18572015/03/13 00:41:48

ポイント200pt

テキストファイルから読み込むときにデータを削除してから 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

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

id:a-kuma3

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

回答に追記しました。

2015/03/14 14:15:55

その他の回答(0件)

id:a-kuma3 No.1

a-kuma3回答回数4488ベストアンサー獲得回数18572015/03/13 00:41:48ここでベストアンサー

ポイント200pt

テキストファイルから読み込むときにデータを削除してから 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

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

id:a-kuma3

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

回答に追記しました。

2015/03/14 14:15:55
id:buri0624

回答有難うございます。

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

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

  • id:buri0624
    回答有難うございます。コメントが遅くなりました。
    大変参考になりました。
    今後もvba関連で何かあれば質問させていただきたいと思いますので
    その際は宜しくお願いします。

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

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

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

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