may the VBA be with you

Excel VBAとか業務自動化とか

VBAでこんなことできます_その2 読み込んだcsvファイルのデータをフィルタかけて別ファイルに出力マクロ

イントロ

どうもinageです。
VBAでどんなことできるかちょちょっと見せる用サンプル第2弾です。

タイトル長い。

どんなマクロ

csvファイルを選択して、読み込んで、任意の列に任意のキーワードでフィルタかけて、別ファイルに出力します。

f:id:vba-belle-equipe:20190818095035p:plain

読み込むcsvとしては
テストデータ・ジェネレータさん
で生成された住所データなどが適当かと思いますが、

基本的に1行目に項目名が入っている普通の表形式のcsvなら
大体対応できる・・・はずなのではないか感がなきにしもあらず
という気がします。

操作シート

検索列を指定して検索語を入れたときに該当件数を出すために、
数式が色々入ってます。
その辺りの内容は前回記事を参照ください。
vba-belle-equipe.hatenablog.com

使い方

1)ファイル選択ボタン-> csvファイルを選択する
2)ファイル読込ボタンを押す
3)「検索列」を選択
4)「検索語」を入力
5)シート作成ボタンを押す
6)xlsx出力かcsv出力のボタンを押す

f:id:vba-belle-equipe:20190818100725g:plain
検索列の指定~シート作成されるまで

※ちらっと写る住所や名前などは、実在しないデータです。

コード抜粋(フィルタかけて新しいシートに出すところ)

    Dim csvWS As Worksheet
    Dim newWS As Worksheet    
    Set ws = ThisWorkbook.Sheets("操作")
    Set csvWS = ThisWorkbook.Sheets("csv")

   'シートを新しく作り、検索語をその名前にする
    sheetName = ws.Range("D8") 
    Set newWS = Worksheets.Add(After:=Sheets(2))
    newWS.Name = sheetName

    Dim i As Long, j As Long
    Dim maxRow As Long
    Dim crRow As Long      '新しいシートのカレント行
    Dim buf As String
    Dim targetCol As Long
    targetCol = ws.Range(対象列アドレス)
    
    With csvWS
        '列名が入った1行目をコピーする
        .Rows(1).Copy newWS.Rows(1)
        '最終行の取得
        maxRow = .Cells(Rows.Count, 1).End(xlUp).Row
        crRow = 1
        For i = 2 To maxRow        
            '検索語と比較する文字列の作成
            buf = .Cells(i, targetCol)

            If InStr(buf, sheetName) > 0 Then
                crRow = crRow + 1
                .Rows(i).Copy newWS.Rows(crRow)
            End If
        Next
    End With

フィルターかけると言いつつ、該当列に検索語が含まれるかを1行1行判定しているだけというのは内緒。

でも色々と条件が加わったりする場合は、用意されているAutoFilterより柔軟に使えたりします。

ファイルのダウンロード

ファイル読込_絞り込み_出力01.xlsm - Google ドライブ


上記リンク先からダウンロードしてください。

できなかったらゴメンナサイ。

諸注意

Windowsで動作します
・デモ用なので、エラー処理とかちゃんとやってません
・自由に使っていただいて構いませんが、自己責任でお願いします
・ちょっとまて! そんなそうびじゃ あぶないぞ