【VBA】ダイアログを使ってCSVファイル読み込み

★★★ Live配信告知 ★★★ぜひお申込みください!
◆◇世界一わかりみの深いクラウドネイティブ on Azure◆◇
8/4(木) 19:00~ 第17回:コンテナをサーバーレスでラクラク実行 〜 Azure Container InstancesとDocker CLIで実現 〜 今回は、コンテナをサーバーレスで実行するテクノロジとDocker CLIとの連携を紹介します。
◆◇PS Live◆◇
8/5(金) 12:00~ 第18回:アウトプットはイイぞ 〜サイオステクノロジーLT大会〜 エンジニア初級者向けから、個人ネタまで、エンジニア脳を体感できるプログラムです。

こんにちは。サイオステクノロジーの川田です。
今回はMicrosoft Officeシリーズ専用のプログラミング言語であるVBAを使ってCSVファイルを読み込みや背景の色付けをしたいと思います。

マクロ実行ボタン作成

作成方法として2つあります。

ボタンにマクロを設定

  1. [開発] -> [挿入] -> [フォームコントロール] -> 左上の「ボタン」をクリックします。
    クリックするとマクロの登録画面が出てきます。
  2. マクロ名入力やマクロ保存先を選択して「OK」をクリックします。
  3. ボタンが作成されます。

 

図形にマクロを設定

  1. [挿入] -> [図形] で図形を選択します。
  2. 作成した図形を右クリックし、「マクロの登録」をクリックします。
  3. マクロ名入力やマクロ保存先を選択して「OK」をクリックします。
  4. ボタンが作成されます。

 

作成したボタンをクリックしても、マクロを作成していないのでまだ動きません!!

VBEを起動

それではコードを作成していきます。

[開発] -> [Visual Basic] をクリックすると、Visual Basic Editorが起動されます。

コードを作成するためには [挿入] -> [標準モジュール]をクリックします。

これでマクロのコードを書く環境が整いました!
では先ほど入力したマクロ名を以下のように入力します。
マクロ名:Button_Click

Public Sub Button_Click()

End Sub

CSVファイルを読み込み

ダイアログ表示

CSVファイルを読み込むために、ダイアログを表示させるマクロを書きます。

Public Sub Button_Click()
    Dim TypeFile, DialogTitle As String
    Dim OpenFileName As Variant

    TypeFile = "CSV ファイル (*.csv),*.csv"
    'ダイアログのタイトルを指定
    DialogTitle = "ファイルを選択して下さい"
    'ファイル参照ダイアログの表示
    OpenFileName = Application.GetOpenFilename(typeFile, , dialogTitle)
End Sub

実際にボタンをクリックするとダイアログが表示されます!


ダイアログを表示させるにはGetOpenFilenameメソッドを使用します。

Application.GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)

今回はFileFilterとTitleを引数に指定しています。
指定すると画像の①にはTitleの「ファイルを選択してください」、②にはFileFilternのCSVファイルのみが表示されます。

キャンセル時の処理は!?

「キャンセル」クリック時に処理を書きたい場合は以下のように書きます。

    If OpenFileName = False Then
        MsgBox "キャンセルされました"
        End
    End If

例は「キャンセル」がクリックされたらMsgBox関数を使って、メッセージボックスを表示させています。

CSVファイルの中身を出力

ExcelにCSVファイルの中身を表示させていきます。
FreeFile([RangeNumber]):使用可能なファイル番号(Integer)を返します。
※RangeNumberを省略した場合は1 ~ 255 の範囲。

    N = FreeFile
    Open OpenFileName For Input As #N
    i = 1
    Do While Not EOF(N)
        i = i + 1
        Input #N, str1, str2
        Cells(i, 1).Value = str1
        Cells(i, 2).Value = str2
    Loop
    Close #N

☞CSVファイルの中身

山田花子,いちご
山田太郎,バナナ
山田次郎,りんご

実行すると中身がExcelのセルに表示されました。

分かりやすくするために項目名を付けたい。色も付けたい。そう思いました。

    Range("a1").Value = "名前"
    Range("b1").Value = "果物"
    Range("a1:b1").Interior.ColorIndex = 35

セルのクリア

今のままではデータを減らして再度CSVファイルの中身を出力した時に、前のデータが残ったままとなってしまいます。
リセットしたい、そんな時は「Clear」を使用します。

Public Sub Button_Click()
    Dim TypeFile, DialogTitle As String
    Dim OpenFileName As Variant
    Dim ws As Worksheet'★
    Set ws = Worksheets("Sheet1")'★

    TypeFile = "CSV ファイル (*.csv),*.csv"
    'ダイアログのタイトルを指定
    DialogTitle = "ファイルを選択して下さい"
    'ファイル参照ダイアログの表示
    OpenFileName = Application.GetOpenFilename(TypeFile, , DialogTitle)

    If OpenFileName = False Then
        MsgBox "キャンセルされました"
        End
    End If
    
    ws.Cells.Clear'★

    N = FreeFile
    Open OpenFileName For Input As #N
    i = 1
    Do While Not EOF(N)
        i = i + 1
        Input #N, str1, str2
        Cells(i, 1).Value = str1
        Cells(i, 2).Value = str2
    Loop
    Close #N

    Range("a1").Value = "名前"
    Range("b1").Value = "果物"
    Range("a1:b1").Interior.ColorIndex = 35
End Sub

★が追加した箇所になります。
こちらを実行すると「Sheet1」がクリアになります。
これでCSVファイルの中身は出力されました!!

ドロップダウンリストを使って色の変更

ドロップダウンリスト作成

次はドロップダウンリストを使って、項目を増やしていきます。
例えばC列に「作成有無」を追加したいと思います。
作成の有無には「未」「済」というドロップダウンリストにします。

Public Sub Button_Click()
    Dim TypeFile, DialogTitle As String
    Dim OpenFileName As Variant
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")

    TypeFile = "CSV ファイル (*.csv),*.csv"
    'ダイアログのタイトルを指定
    DialogTitle = "ファイルを選択して下さい"
    'ファイル参照ダイアログの表示
    OpenFileName = Application.GetOpenFilename(TypeFile, , DialogTitle)

    If OpenFileName = False Then
        MsgBox "キャンセルされました"
        End
    End If
    
    ws.Cells.Clear

    N = FreeFile
    Open OpenFileName For Input As #N
    i = 1
    Do While Not EOF(N)
        i = i + 1
        Input #N, str1, str2
        Cells(i, 1).Value = str1
        Cells(i, 2).Value = str2
    Loop
    Close #N

    Range("a1").Value = "名前"
    Range("b1").Value = "果物"
    Range("c1").Value = "作成有無" '★
    Range("a1:c1").Interior.ColorIndex = 35

    '★追加
    With Range(Cells(2, 3), Cells(i, 3)).Validation
    .Delete
    .Add _
     Type:=xlValidateList, _
     Formula1:="未,済"
    End With
    '★追加
End Sub

★の部分を追加してCSVファイルを読み込むと以下のようになります。
C列に「未」「済」が選択できるようになりました。

背景色の変更

特定のセルが変更されたときにマクロを実行方法になります。

  1. [Sheet1] を右クリックし、[コードの表示] をクリックします。
  2. Sheet1のモジュールシートが表示されるので「WorkSheet」を選択します。
  3. 右側のプルダウンから「Change」を選択します。

選択するとWorksheet_Changeが作成されました。
※今回Worksheet_SelectionChangeは不要なので削除してください。

Private Sub Worksheet_Change(ByVal Target As Range)

End Sub

Worksheet_Changeにセルの値が変更時の処理を記載していきます。
「済」が選択された場合に対象の行をグレーにしていきます。

    If Not Intersect(Target, Columns("C")) Is Nothing Then

    End If

Intersectは重なっている部分のセル範囲を取得することが出来ます。
※重なるセルがない場合は、Nothingが返されます。

いよいよ色付けしていきます。
Select Case文を使って「済」を選択した行をグレーにしています。

    If Not Intersect(Target, Columns("C")) Is Nothing Then
        Dim i As Integer
        i = Target.Row
        Select Case Cells(i, 3)
            Case "済"
                Range(Cells(i, 1), Cells(i, 3)).Interior.Color = RGB(192, 192, 192)
        End Select
    End If

セル範囲の行列番号取得

Target.Rowはセル範囲の行番号を取得します。
Target.Columnはセル範囲の列番号を取得します。
以下も追加すると画像のように変更した列と行が表示されます。

MsgBox "変更されたセルは" & x & "列目の" & y & "行目です。"

でもこれって。「未」に変えたらグレーのままなんじゃ。。。って思いますよね。
なので「未」が選択された場合は背景色を塗りつぶし無しする実装を加えます。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("C")) Is Nothing Then
        Dim i As Integer
        i = Target.Row
        Select Case Cells(i, 3)
            Case "済"
                Range(Cells(i, 1), Cells(i, 3)).Interior.Color = RGB(192, 192, 192)
            Case "未"
                Range(Cells(i, 1), Cells(i, 3)).Interior.ColorIndex = xlNone
        End Select
    End If
End Sub

Case “未”の部分が追加した箇所です。
xlNoneを指定すると背景色がクリアされます。

いかがでしたでしょうか。
今回は3件でしたが、何百件、何千件になると手動入力は大変ですよね。
VBAを使うことによって今やっている作業が楽になるかもしれません。





ご覧いただきありがとうございます。
ブログの最新情報はSNSでも発信しております。
ぜひTwitterのフォロー&Facebookページにいいねをお願い致します!



>> 雑誌等の執筆依頼を受付しております。
   ご希望の方はお気軽にお問い合わせください!


ご覧いただきありがとうございます! この投稿はお役に立ちましたか?

役に立った 役に立たなかった

2人がこの投稿は役に立ったと言っています。

Be the first to comment

Leave a Reply

Your email address will not be published.


*