行数が増減する表で一定の行の下に見出し行を挿入するには?

Question 62.3 Previous Next
突然で申し訳ありません。いつも、HP並びに”Excel VBAマクロ 組み方講座”には、大変お世話になっています。
今年の3月から、エクセルVBAの勉強を始め、悪戦苦闘をしながら、HP並びに”Excel VBAマクロ 組み方講座”のおかげでやっと中級に踏み込んだかな・・・と過去(たった5ケ月ですが)を振り返っています。
お忙しい中、申し訳ありませんが、次のマクロがうまくいかず、3週間ほど悩んでいます。 なかなか突破口がみつからず、すごく悩んでいます。 何卒教えてください。m(_ _)m
----------------------------
 テキストデータ          完成データ
テキストデータ 完成図 テキストデータをよく事務仕事で使います。
最左図がテキストデータ(TXT形式)をエクセルで開いた直後の状態で、その右が完成図です。

今回は、縦方向が不確定な上で、毎月のデータ(実績)が縦方向のみに変動し、その上、会社名(M商事等)のすぐ下に”見出し”を加えなければいけないのです。

マクロ経験が浅い私も、がんばってみましたが、どうもこの部分がうまくいきませんでした。
これは、私がマクロの世界に入るきっかけになった先生にきくしかない!と思った次第です。
なにとぞ救いの手を!
Answer   Copyright (C) 2002.8.26 永井善王
勉強を始められて5か月、完成図がしっかり描け、よく頑張ってみえるようですね。
この処理は難しく考えないで、1件目のデータから順に処理する方法が分かりやすいでしょう。ただし、テキストデータの件数が非常に多いと処理時間が掛かる場合がありますが、不慣れなうちから高望みをしないで、着実に進むことをお勧めします。

回答の都合上、下記のように前提条件を決めておきます。
 ・2つの図とも左から順に A、B、C列…とし、A列を仮に「区分」と呼ぶ
 ・テキストデータは前もって開かれていて、ファイル名は「テキスト.txt」
 ・完成データは、別に準備されているブック(顧客別.xls)の「完成」シートに作成する
処理の流れ
詳細は こちら  1. テキストデータをコピーして、「完成」シートへ貼り付ける
 2. 貼り付け後データの最初の行から順に1行ずつ反復処理する
 3. 貼り付け後データの区分が '9' ならば、処理を終わる
 4. 同じく '1' ならば、挿入した行のセルに "見出し1" のように文字をセットして処理を続ける
 ※ご愛読中の「Excel VBAマクロ 組み方講座」本では、下記のページが参考になります。
    136ページ: Do While…Loopステートメント
    79ページ:  If…Then…Elseステートメント
マクロ作成の概要
 1. 新規ブックとして顧客別.xls(シート名…完成)を作成しておく ・・・ マクロは、このブックに作成する
 2. パーツとなるマクロを自動記録で作成する ・・・ 下記 A
 3. 反復処理のマクロコードを入力する (自動記録できないので) ・・・ 下記 B
 4. 自動記録したマクロを改造する ・・・ 下記 C

A. パーツとなるマクロを自動記録する
 1-1. 準備: 「顧客別.xls」を開き、次に「テキスト.txt」を開いて、自動記録を開始する (マクロ名は下記参照)
 1-2. テキスト.txtの「テキスト」シートをすべて選択してコピーする
 1-3. 顧客別.xlsの「完成」シートの A1セルを選択して貼り付けし、自動記録を終了する
Sub テキストデータをすべてコピーする()
    Windows("顧客別.xls").Activate
        Cells.Select
        Selection.Clear
    Windows("テキスト.txt").Activate
        Cells.Select
        Selection.Copy
    Windows("顧客別.xls").Activate
        Range("A1").Select
        ActiveSheet.Paste
End Sub
 2-1. もう一度、自動記録を開始する(マクロ名は下記参照)
 2-2. (顧客別.xlsの「完成」シートの) 2行目を選択し、行を挿入する
 2-3. B2セルを選択し、'見出し1' と入力して、自動記録を終了する
Sub 見出し行を挿入する()
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "見出し1"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ミダ"
End Sub
B. 反復処理のマクロコードを入力する
 3-1. 準備: VBE画面で、顧客別.xlsの標準モジュールのModule1のコードを表示する
 3-2. 先頭(自動記録されたマクロの上部)に下記のとおり入力する
Option Explicit
Dim 行

Sub テキストデータに見出し行を挿入した表を作成する()
    テキストデータをすべてコピーする
    行 = 1
    Do While Range("A" & 行) <> "9"
        If Range("A" & 行) = "1" Then
            見出し行を挿入する
        End If
        行 = 行 + 1
    Loop
End Sub
C. 自動記録したマクロを改造する
 4-1. 準備: 「見出し行を挿入する」マクロを表示する
 4-2. 下記のとおり修正・追加・削除する
改造後のマクロ
← ピンクで囲んだ部分を修正する(2カ所)

← 藤色で塗りつぶした部分を修正する(2カ所)




← 最後にあったフリガナのコードは削除する

これで出来上がりです。 が、少し補足しておきます。
Do While…Loopステートメントで使っているカウンタは変数「行」で、その値に 1づつ加え(上記 B.の下から 3行目のコード)ながら最下行まで反復処理しています。 それに関連する上記 C.の 4行目のコードの意味が理解できますか?

3行目のコードでカウンタの値に 1加えた行に新しい行が挿入され、直後にアクティブセルの行番号を取得してカウンタに代入しています。カウンタには、その後、上述のとおり、さらに 1加えられますので、次のループで調べられる行は、挿入した見出し行の次の行ということになります。 わざわざ、こんなことをしなくても、
行 = 行 + 1 としても構いませんが、このような手法が必要になる場合がありますから、少しづつ覚えておくとよいでしょう。
参考ページ
アクティブセルの位置を調べる
サンプルブック(テキストファイル含む)のダウンロードは
ここをクリック (YNxv9c5_DoWhileLoop.lzh 9KB)
※ 一旦、ハードディスクに保存し、解凍してから、2つともExcelで開いておきます。(txtはタブ区切り)

Excel VBA Macro