投稿/コメントを表示します。

エクセルVBA外部連携講座
テキストファイルの操作について

たかちゃんさんの投稿

(投稿ID: 4988)

気象庁のページから以下の条件で、CSVファイルをダウンロードし
時刻が9：00の行の日時と気温データを取得しグラフを作成する
マクロを作成してみました。
Excel2019で動作確認済み。

前準備
１．気象庁のページからCSVファイルをダウンロードする
場所：羽田と八戸
取得データ：気温
期間：2020/12/1～2020/12/31

２．以下のような名前をつけて、kion という名前のフォルダの中に入れておく
HanedaDec.csv
HachinoheDec.csv

マクロの動き
１．9:00の行のデータのみ取得。
２．配列に格納
３．CSVのファイル名のシートを作成し、データの書き出し＆折れ線グラフを作成

CreateGrapthに関しては、自動記録で作成しました。

【参考URL】
http://it-benkyou.seesaa.net/article/435728508.html
Option Explicit
'Microsoft Scripting Runtime にチェックを入れる→FSO使用のため
Dim fName As String

 Sub CreateData()
    Dim fs As New Scripting.FileSystemObject
    Dim files As Scripting.files
    Dim file As Scripting.file
    Dim csvFile As Scripting.TextStream
    Dim csvData As String
    Dim SPcsvData As Variant
    Dim c As Long
    Dim cnt As Long
    Dim ar() As Variant '()がないと動かないので要注意！！！
    Dim Dstr As String
    Dim D As Date
    Dim path As String
    
    'CSVファイルは、kionフォルダ内にいれておく
    path = ThisWorkbook.path & "\kion"
    
    
    Set files = fs.GetFolder(path).files
    
    'kionフォルダ内、全てのCSVファイルについて処理
    For Each file In files
    
        Set csvFile = fs.OpenTextFile(file, IOMode:=ForReading)
        fName = fs.GetBaseName(file) 'シート名作成用にファイル名を取得
        
        cnt = 0 '配列で使うカウント用
        
        'CSVファイルを最後の行まで読む
        Do While csvFile.AtEndOfStream <> True
        
            '最初のヘッダー行と最終行の2021/1/1が入らないように、先頭4文字が2020の行と
            'いう条件を設定
            csvData = csvFile.Read(4) '行の先頭4文字をcsvDataに代入
            If csvData = "2020" Then
            '1度4文字を読んでいる為、4文字以降から読み始めるので4文字(2020)を付け足した
                csvData = "2020" & csvFile.ReadLine
                SPcsvData = Split(csvData, ",")
                Dstr = SPcsvData(0) '日時データを文字列として格納
                D = CDate(Dstr) 'CDate関数を使用して、文字列→Data型に変換
                
                '9:00のデータだけを取得し、配列に格納
                If Hour(D) = 9 Then
                    ReDim Preserve ar(1, cnt)
                    ar(0, cnt) = SPcsvData(0) '日時
                    ar(1, cnt) = SPcsvData(1) '気温（必要な日時と気温のデータのみ配列に格納）
                    cnt = cnt + 1
                End If
                
            Else
                csvFile.SkipLine
            End If
        Loop
        
        'グラフを作る為に、一度Excelに書き出す
        Dim Nws As Worksheet
    '    Worksheets.Add after:=Worksheets(Worksheets.Count)
        Set Nws = Worksheets.Add
        Nws.Name = fName
        
        For c = LBound(ar, 2) To UBound(ar, 2)
            Worksheets(fName).Range("A1").Offset(c).Value = ar(0, c)
            Worksheets(fName).Range("B1").Offset(c).Value = ar(1, c)
        Next
        
        CreateGraph
        '次の処理でも使うので配列の中を消しておく！
        Erase ar
    Next
    
    Set csvFile = Nothing
    Set file = Nothing
    Set files = Nothing
    Set fs = Nothing
    
End Sub

Private Sub CreateGraph()
'Excelの自動記録でグラフを作成
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ws.Range("A1").CurrentRegion.Select
    ws.Shapes.AddChart2(227, xlLineMarkers).Select
    ActiveChart.SetSourceData Source:=ws.Range("A1").CurrentRegion
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).CategoryType = xlCategoryScale
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = -15
    ActiveChart.Axes(xlValue).MaximumScale = 20
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = fName & "気温"

    With Selection.Format.TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 2).Font
        .BaselineOffset = 0
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(89, 89, 89)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 14
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Spacing = 0
        .Strike = msoNoStrike
    End With
   
End Sub

2021/01/15 21:24