たかちゃんさん:

すごいですね。
csvFile.Close　の書き忘れ以外は完璧だと思います。

お遊びですが、配列からセルへの書き戻しをシンプルにし、変数の数も減らしてみました。

Sub CreateData_Tanaka()
    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 cnt As Long
    Dim ar() As Variant '()がないと動かないので要注意！！！
    
    'CSVファイルは、kionフォルダ内にいれておく
    Set files = fs.GetFolder(ThisWorkbook.path & "\kion").files
    
    'kionフォルダ内、全てのCSVファイルについて処理
    For Each file In files
    
        Set csvFile = fs.OpenTextFile(file, IOMode:=ForReading)
        
        cnt = 0 '配列で使うカウント用
        
        'CSVファイルを最後の行まで読む
        Do While csvFile.AtEndOfStream <> True
        
            csvData = csvFile.ReadLine
            If Left(csvData, 4) = "2020" Then
                '9:00のデータだけを取得し、配列に格納
                If Hour(CDate(Split(csvData, ",")(0))) = 9 Then
                    ReDim Preserve ar(1, cnt)
                    ar(0, cnt) = Split(csvData, ",")(0) '日時
                    ar(1, cnt) = Split(csvData, ",")(1) '気温
                    cnt = cnt + 1
                End If
            End If
        Loop
        
        '読み終わった閉じる
        csvFile.Close
        
        'グラフを作る為に、一度Excelに書き出す
        Dim Nws As Worksheet
        Set Nws = Worksheets.Add
        Nws.Name = fs.GetBaseName(file)

        '配列からセルに一行で書き戻し
        Nws.Range("A1").Resize(UBound(ar, 2) + 1, UBound(ar, 1) + 1).Value = _
            Application.WorksheetFunction.Transpose(ar) 'Excel関数で行列入替

        'ファイル名をSubプロシージャに渡し、モジュールレベル変数を使用しない
        CreateGraph Nws.Name
        
        '次の処理でも使うので配列の中を消しておく！
        Erase ar
    Next
    
    Set csvFile = Nothing
    Set file = Nothing
    Set files = Nothing
    Set fs = Nothing
End Sub

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

2021/01/16 03:33

田中 宏明さん:

いつもありがとうございます！
Close、すっかり忘れていました。。

変数の数も減り、見違えるほどスッキリし読みやすいです。
Resizeとは何だろう？何故Transposeをしているんだろう？と思い
試しに、以下のように設定し動かしてみたら、何故だか分かりました。(;ﾟД ﾟ)

Nws.Range("A1").Resize(UBound(ar, 1) + 1, UBound(ar, 2) + 1).Select
        
       Nws.Range("A1").Resize(UBound(ar, 1) + 1, UBound(ar, 2) + 1).Value = ar

Split(csvData, ",")(0)のような書き方があるのも、初めて知りました。
モジュール変数使わずに、引き渡した方が可読性が上がってとても良いですね。

こんな風に書けば良いのかと、とても勉強になりました。
毎回、本当にどうもありがとうございます！！！

> すごいですね。
> csvFile.Close　の書き忘れ以外は完璧だと思います。
>
> お遊びですが、配列からセルへの書き戻しをシンプルにし、変数の数も減らしてみました。

2021/01/16 08:26

たかちゃんさん:

こちらこそ、コメントありがとうございます。

> Resizeとは何だろう？
セル範囲のサイズを変更するResizeプロパティは、セル範囲をスライドするOffsetプロパティとの組合せで役立つことがあるかもしれません。

例えば、セルA1を含む表のセル範囲を1行下にスライドし、セル範囲のサイズを「行数 - 1」行に変更する場合、以下のようになります。

With Range("A1").CurrentRegion
  .Offset(1).Resize(.Rows.Count - 1).Select
End With

2021/01/16 17:08

たかちゃんさん、田中さん:

おはようございます。
すごいですね。。本当に。もはや、ただただ、レスペクトするよりないです。

とはいえ、いろいろなコードを見て学ぶのも楽しい時期かなとも思いますので、いただいたコードを元にして、全体をリファクタリングしてみました。

[1] 複数の処理を担うことで行数が多くなっているプロシージャを極力分割。
[2] 自動記録で生成されたコードからselect, selectionをはずす。Withを使って整形してみた。
[3] 既存シートがある場合の処理を追加。(On Errorでエラー処理内で書いてしまうののは、雑だけど有効な書き方です)
等々。

[1]は、どこまでやるかは、状況と、好み次第かと。
僕は（特に、最近の僕は）、機能ごとに分割するのが割と好きです。

こういうのは、未開拓の状態から最初にたたき台を作った方の功績がいちばん大きいです。既存のものをいじるのは、たたき台になる最初のコードを生成するより簡単です。なので、人の努力の上に乗っかっているだけというようなモンですが。

Option Explicit
'Microsoft Scripting Runtime にチェックを入れる→FSO使用のため
Sub CreateData_Tanaka_Ogawa()
    Dim fs As New Scripting.FileSystemObject
    Dim file As Scripting.file
    Dim ar() As Variant
     
    For Each file In fs.GetFolder(ThisWorkbook.path & "\kion").files 'CSVファイルは、kionフォルダ内にいれておく
        ar = getTempDataFromCSV(file)
        setNewSheetDataGraph file, ar
        Erase ar
    Next
    
    Set file = Nothing
    Set fs = Nothing
End Sub
 
Private Function getTempDataFromCSV(file As Scripting.file) As Variant()
    Dim fs As New Scripting.FileSystemObject
    Dim csvFile As Scripting.TextStream
    Dim csvData As String
    Dim cnt As Long
    Dim ar() As Variant
    
    Set csvFile = fs.OpenTextFile(file, IOMode:=ForReading)
    cnt = 0
    Do While csvFile.AtEndOfStream <> True 'CSVファイルを最後の行まで読む
        csvData = csvFile.ReadLine
        If Left(csvData, 4) = "2020" Then
            If Hour(CDate(Split(csvData, ",")(0))) = 9 Then '9:00のデータだけを取得し、配列に格納
                ReDim Preserve ar(1, cnt)
                ar(0, cnt) = Split(csvData, ",")(0) '日時
                ar(1, cnt) = Split(csvData, ",")(1) '気温
                cnt = cnt + 1
            End If
        End If
    Loop
    csvFile.Close '読み終わったら閉じる
    
    Set csvFile = Nothing
    Set fs = Nothing
    
    getTempDataFromCSV = ar
End Function
Private Sub setNewSheetDataGraph(file As Scripting.file, ar() As Variant)
    Dim ws As Worksheet
    Set ws = createNewSheet(file)
    With ws
        .Range("A1").Resize(UBound(ar, 2) + 1, UBound(ar, 1) + 1).Value = Application.WorksheetFunction.Transpose(ar)
        .Range("A1").CurrentRegion.Columns.AutoFit '表示が#####等になってしまう問題を解消。選択された範囲のセル内の値を表示できるよう列幅をあわせる
    End With
    CreateGraph ws
End Sub
Private Function createNewSheet(file As Scripting.file)
    'シート作成。既存シートがある場合は削除してから作成。
    Dim fs As New Scripting.FileSystemObject
    Dim name As String
    name = fs.GetBaseName(file)
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(name).Delete
    Application.DisplayAlerts = True
    If Err.Number = 0 Then
        Debug.Print name & "がすでにあったので削除しました。"
    ElseIf Err.Number = 9 Then
        Debug.Print name & "が存在しないので削除処理は行われませんでした。"
    Else
        MsgBox Err.Number & vbNewLine & "想定外のエラー！" & vbNewLine & Err.Description
    End If
    On Error GoTo 0
    
    Worksheets.Add
    ActiveSheet.name = name
    Set createNewSheet = ActiveSheet
End Function
 
Private Sub CreateGraph(ws As Worksheet)
    '[*} https://docs.microsoft.com/ja-jp/office/vba/api/excel.xlcharttype を参照したが、227を置き換える列挙体の値を見つけられなかった。
    '    https://www.muscle-hypertrophy.com/?p=9966 によれば xlLine で置き換え可能らしいので試してみたが、ダメだった。
    Dim sp As Shape
    Set sp = ws.Shapes.AddChart2(227, xlLineMarkers) '[*]
'    Set sp = ws.Shapes.AddChart2(xlLine, xlLineMarkers) '[*]
    With sp.Chart
        .SetSourceData Source:=ws.Range("A1").CurrentRegion
        .Axes(xlCategory).CategoryType = xlCategoryScale
        With .Axes(xlValue)
            .MinimumScale = -15
            .MaximumScale = 20
        End With
        With .ChartTitle
            .Text = ws.name & "気温"
            With .Format.TextFrame2.TextRange.Characters(1, 2)
                With .ParagraphFormat
                    .TextDirection = msoTextDirectionLeftToRight
                    .Alignment = msoAlignCenter
                End With
                With .Font
                    .BaselineOffset = 0
                    .Bold = msoFalse
                    .NameComplexScript = "+mn-cs"
                    .NameFarEast = "+mn-ea"
                    With .Fill
                        .Visible = msoTrue
                        .ForeColor.RGB = RGB(89, 89, 89)
                        .Transparency = 0
                        .Solid
                    End With
                    .Size = 14
                    .Italic = msoFalse
                    .Kerning = 12
                    .name = "+mn-lt"
                    .UnderlineStyle = msoNoUnderline
                    .Spacing = 0
                    .Strike = msoNoStrike
                End With
            End With
        End With
    End With
End Sub

2021/01/17 19:18

小川先生、田中さん

おはようございます。

ネットで良さそうな題材を見つけ、実際の仕事を想定して
試行錯誤していました。早速、教えて頂いた情報をもとに
複数ファイルのコードを改良していきたいと思います。
本当にいつもありがとうございます。m(_ _)m

ユーザ側を考慮してフォルダを選択させるなど、ちょっとした事ですが
あると無いでは全く違いますね。(^^)

因みに、[データ]→[データの取得」や[テキストまたはCSVから]を
試した所、文字化けもなく綺麗に開きました。
今回のパターンは、必要なデータをシートにコピー出来ればよいだけ
なので、こういった方法もあるのだと勉強になりました。(^^;
（日付は、別途追記で。）

> たかちゃんさん、田中さん:
>
> おはようございます。
> とはいえ、いろいろなコードを見て学ぶのも楽しい時期かなとも思いますので、いただいたコードを元にして、全体をリファクタリングしてみました。

2021/01/18 07:32