スポンサーリンク

ドキュメント作成を楽にするための，Excel VBA 頻出８パターン

VBA x個のy iPod ドキュメント excel


ドキュメント内で面倒な整形 / 抽出 / 変換作業をマクロにやらせたい場合，たいてい下記の８パターンが軸になる。

これだけでVBAの入門として十分だろう。


シート内の処理

  • （１）全シートのスキャン
  • （２）シート内全行のスキャン
  • （３）シート内の更新イベントを拾う
  • （４）大量データの一括処理

シート外の処理

  • （５）ファイル出力（書き込み）
  • （６）ファイル入力（読み取り）
  • （７）外部コマンド呼び出し
  • （８）DB接続

これらのサンプルコードを下記に並べて，コピペ可能にしておく。


最後にちょっとした応用として，

  • シートの内容をiPod用分割テキストに出力

というのを載せる。


※↑ もくじジェネレータ で自動生成

事前の参考：

システム開発生産性が最も高い言語・・・Excel
http://itpro.nikkeibp.co.jp/article/COLUMN/20070906/281286/

（１）全ワークシートのスキャン

全シートのシート名を順番に表示

Sub ScanSheets()
    ' 全ワークシートに対して
    For Each sheet In Worksheets

        ' このシートを表示
        sheet.Activate

        ' このシートに対する処理
        MsgBox sheet.Name ' シート名を表示

    Next sheet
End Sub

↑目次へ戻る

（２）シート内全行のスキャン

上から行を読み取る。

全シートのスキャンとシート内全行のスキャンを組み合わせれば，「各シートの各記載項目に一意な連番をふる」ような作業ができる。

' シート変数 sheet を指定したい場合は，Cellsを呼ぶ際に sheet.Cells とすること。

Sub ScanColumns()
    
    ' 設定
    offset_row = 5 ' スキャン開始行
    emptytest_col = 2 ' 空かどうか判定する列
    
    ' ループ
    row_num = offset_row ' カウンタ
    continue_flag = True
    Do While continue_flag = True
        
        ' セルが空か
        emptytest_str = Cells(row_num, emptytest_col).Value
        If Len(emptytest_str) = 0 Then
            
            ' 終了
            continue_flag = False
        
        Else
            ' この行の処理
            Cells(row_num, 10).Value = "hoge" ' 10列目にhogeと入力
            
            ' 次の行へ
            row_num = row_num + 1
        End If
    
    Loop
    
    ' 終了
    MsgBox "終了しました。スキャンした行の数：" & (row_num - offset_row)
    
End Sub

↑目次へ戻る

（３）シート内の更新イベントを拾う

セルが編集されたタイミングを見計らって，入力値のチェックなどしたい場合がある。

編集イベントのTargetを拾えばよい。


ThisWorkBook のモジュールに下記のコードを追加。

' シート内容更新時のイベント
Private Sub Workbook_SheetChange( ByVal sheet As Object, ByVal rng As Range )

  MsgBox rng.Row & "行" & rng.Column & "列を編集しました。"

End Sub

参考：

Google 検索の「サジェスト機能」を， Excel のシート上にVBAで作る　（セルの内容に応じて入力規則を動的に変える方法）
http://d.hatena.ne.jp/language_and_engineering/20081125/1227571724

↑目次へ戻る

（４）大量データの一括処理

一括処理は，表計算ソフトならではの機能。

  • 大量Read＝シート内検索
  • 大量Write＝シート内フィル

こういった一括処理系のロジックは，
ExcelやVBAに組み込みの関数を使うこと。

もしFor文等で独自に実装してしまうと，むちゃくちゃ動作が遅くなり，実行時間が数千倍かかる。



大量データからの特定データ読み出し＝シート内検索

プロジェクトの用語集　テンプレート　（検索ボックス付き Excel シート）
http://d.hatena.ne.jp/language_and_engineering/20090304/p1

  • シート内でkey文字列を含むセルを検索
  • Worksheets("sheet1").Cells.Find(key)


大量データの書き出し＝シート内フィル

Excelシート上で指定領域をオートフィルするVBAマクロ
http://d.hatena.ne.jp/language_and_engineering/20080929/1222698371

  • Range(～).AutoFill ' 連続データ作成
  • Range(～).FillDown ' 複写

↑目次へ戻る

（５）ファイル出力（書き込み）

ここで，入力よりも出力を先に持ってきたのには十分なわけがある。


Excelはデータの最終形態ではない。

むしろ，それらデータの整理・加工といった中間的な役割をパッパと果たすのに適している。

例えば，

  • Excelのテーブル定義書から大量のDDLを一括生成する　とか
  • Excelの設定一覧シートから大量のXML設定ファイルを一括生成する　とか。

それぞれ，データの最終形態はSQLファイルやXMLファイルが該当する。Excelは補助でしかない。


Excelから外部への速やかなアウトプットが可能ならば，ドキュメントを開発工程にインテグレーションできるのだ。



下記は文字列をテキストファイルに書き出すコード。

br = vbNewLine ' 改行
tb = vbTab ' タブ

' 出力パス
output_path = ThisWorkbook.Path & "\" & "temp.txt"

' ファイルを開く
fp = FreeFile 
Open output_path For Output As #fp

' 書き込み（行末に改行が付加される）
Print #fp, tb & "hoge" & br

' 終了
Close #fp


Printは末尾に改行をつけて出力される。

行の末尾にセミコロンを付けると改行は抑制される。

http://chaichan.web.infoseek.co.jp/vbtips/VBMemo2007011801.htm


文字コードを変えて出力したい場合：

    ' UTF-8で書き出し
    output_path = ThisWorkbook.Path & "\a.txt"
    Dim ados As Object
    Set ados = CreateObject("ADODB.Stream")
    ados.Open
    ados.Type = 2
    ados.Charset = "UTF-8"
    ados.WriteText "ほげ"
    ados.SaveToFile output_path, 2
    ados.Close

これはBOM付きのUTF8になる。UTF8Nでのファイル出力は http://d.hatena.ne.jp/language_and_engineering/20090704/p1 を参照。


参考：

Excelシート上のデータを DB にインポートするVBAマクロ
http://d.hatena.ne.jp/language_and_engineering/20090327/p1


↑目次へ戻る

（６）ファイル入力（読み取り）

テキストファイルから行ごとに読み取り。

Sub GetLines()

    ' 入力パス
    input_path = ThisWorkbook.Path & "\" & "temp.txt"
    If Dir(input_path) = "" Then
        MsgBox input_path & "は存在しません。"
        Exit Sub
    End If
    
    ' ファイルを開く
    
    fp = FreeFile
    Open input_path For Input As #fp
    row_num = 1 ' カウンタ
    Do Until EOF(fp)
        ' 読み取り（行末の改行はトリムされる）
        Line Input #fp, temp_str
        
        ' 読み取った内容をシート上に表示
        Cells(row_num, 1).Value = temp_str
        Cells(row_num, 2).Value = Len(temp_str)

        ' 次の行へ
        row_num = row_num + 1
    Loop
    
    Close #fp
    

End Sub

ファイルの存在判定もDir()で済む。

※ディレクトリの場合は引数にvbDirectoryをつける。
http://www.k1simplify.com/vba/tipsleaf/leaf243.html

↑目次へ戻る

（７）外部コマンド呼び出し

Excelを「実行可能ドキュメント」に仕立て上げるために必須。

Sub ExecPipe()
    
    ' デフォルトのカレントディレクトリはマイドキュメント
    
    ' ChDir/ChDriveはUNCパスの設定は不可
    ChDrive ThisWorkbook.Path
    ChDir ThisWorkbook.Path
        'MsgBox CurDir
    
    output_path = ThisWorkbook.Path & "\a.txt"
    ' コマンド実行
    Shell "cmd.exe /c dir > " & output_path
    
    MsgBox "終了"

End Sub


実行可能ドキュメントとは，「仕様書を書けば，その仕様書自体が動く」という考え方。

例えば

  • テスト仕様書を書いた。その書面上から，書いてあるテストを直接実行できる。

といった感じ。


参考：

テーブル定義書から，Javaのエンティティクラスを自動生成する VBA マクロ
http://d.hatena.ne.jp/language_and_engineering/20081229/1230563126

↑目次へ戻る

（８）DB接続

下記URLを参照。


読み出し

実行環境付きのＳＱＬ例文集　（ExcelのドキュメントからDBにアクセス）
http://d.hatena.ne.jp/language_and_engineering/20090127/1233067389

書き込み

Excelシート上のデータを DB にインポートするVBAマクロ
http://d.hatena.ne.jp/language_and_engineering/20090327/p1


↑目次へ戻る

おまけ：シートの内容をiPod用のテキストに書き出す

iPodでは大きなサイズのテキストは読めないので，適度な大きさで分割する。

' シートの内容をipod用のテキストに出力します
Sub ipodtxt()

    ' 1テキストを4000文字までに制限
    ' http://d.hatena.ne.jp/language_and_engineering/20081106/1225988771
    
    br = vbNewLine
    
    
    ' ダンプしたいシート名
    ws_name = ActiveSheet.Name
        
    ' txt中の最大文字数
    ch_max = 1500
    
    ' txtファイルの名前の前半部分
    txt_basename = "Excelシート"
    
    
    ' 書き込み時カウンタ
    txt_num = 1
    line_index = 1
    ch_num = 0
    
    ' txtを作りたいディレクトリ
    dir_txt = ThisWorkbook.Path & "\" & "保管_" & txt_basename
    If Dir(dir_txt, vbDirectory) = "" Then
        ' http://www.k1simplify.com/vba/tipsleaf/leaf243.html
        ' http://www.k1simplify.com/vba/tipsleaf/dir.html
        MkDir dir_txt
    End If
    
    ' ファイルオープン
    ' http://d.hatena.ne.jp/language_and_engineering/20081229/1230563126
    output_path = dir_txt & "\" & txt_basename & CStr(txt_num) & ".txt"
    fp = FreeFile
    Open output_path For Output As #fp
    
    ' 開始地点
    y_offset = 2 ' 読み取り開始行
    x_offset = 1 ' 読み取り列
    y = y_offset
    
    ' 上から順番に読み込み
    While Len(Sheets(ws_name).Cells(y, x_offset).Value) > 0
        
        temp_line = Sheets(ws_name).Cells(y, x_offset).Value
        
        ' もし4000字を超えてしまうなら，その前にtxt変更
        ch_num = ch_num + Len(temp_line)
        If ch_num > ch_max Then
            ' 今のファイルを閉じる
            Close #fp
            
            ' 新規ファイル
            txt_num = txt_num + 1
            output_path = dir_txt & "\" & txt_basename & CStr(txt_num) & ".txt"
            Open output_path For Output As #fp
            
            ' 文字数もリセット
            ch_num = 0
        End If

        ' 現在のファイルに書き込み
        Print #fp, temp_line
        
        ' 次の行へ
        y = y + 1
        line_index = line_index + 1
    Wend
    
    Close #fp
    MsgBox txt_basename & "txt作成完了"

End Sub

なお，ファイルが増えると，急にipodがファイルを認識しなくなる場合がある。

そういう時には，ファイル名に日本語を使わないようにすれば元通り全ファイルを読み込めたりする。

↑目次へ戻る

補足：別エントリ

VBA（2007もOK）で，ファイルの再帰検索をしよう（Application.FileSearchで複数のブックを処理）
http://d.hatena.ne.jp/language_and_engineering/20090429/p1

↑目次へ戻る

参考：他のTips

Option Explicitは，「使え」（実行時ミスが減るから）という意見と，「使うな」（VBE編集時に煩わしすぎる）という意見がある。

MS Officeで役立つVBAの技：これだけは覚えとけ！
http://builder.japan.zdnet.com/news/story/0,3800079086,20367444,00.htm


　

language_and_engineering 読者になる

広告を非表示にする
スポンサーリンク
スポンサーリンク