田中 宏明さん:
ありがとうございます。
重複しないリストだけでも、本当に色々な方法があるのですね。
VBAが書けると選択肢が増えて楽しいです。

> たかちゃんさん:
>
> > コード読みました！関数も組み合わせて使うと、最強ですね。
> Application.WorksheetFunctionでExcel関数を利用すると便利な場面は多くありますね。
> 一方、小川先生の講座は、VBA初学者がExcel関数に頼ることなく、最初は条件分岐や繰り返しのコードを学び、それを実践していくといった遠回りな方法かもしれませんが、確実に腕力をつけることを重視されており、Excel関数を利用する方法は、紹介程度に留めているのだと思います。
>
> 既にご存知の Countifは、重複のないリストを作成する場合にも使えますよ。
> http://officetanaka.net/excel/vba/tips/tips182.htm

たかちゃんさん:

> コード読みました！関数も組み合わせて使うと、最強ですね。
Application.WorksheetFunctionでExcel関数を利用すると便利な場面は多くありますね。
一方、小川先生の講座は、VBA初学者がExcel関数に頼ることなく、最初は条件分岐や繰り返しのコードを学び、それを実践していくといった遠回りな方法かもしれませんが、確実に腕力をつけることを重視されており、Excel関数を利用する方法は、紹介程度に留めているのだと思います。

既にご存知の Countifは、重複のないリストを作成する場合にも使えますよ。
http://officetanaka.net/excel/vba/tips/tips182.htm

田中 宏明さん:

コード読みました！関数も組み合わせて使うと、最強ですね。
読むのも簡単ですし。(^^)

今回改めてエクセルの素晴らしさに気づきました。
標準機能については、割と知っている方だと思っていましたが
とんでもない誤解でした。(^^;;

早速、エクセルを使用したデータ分析について少し復習をしていました。
既に知っている関数でも使い方次第で、このような判定もできるんだと
気づきました。言われれば「なるほど！」と思いますが、
意外と思いつかないのです。

【例】
Countifを使って、セルの中に"株式会社"の文字が入っているか判定
含む場合は"1"、含まない場合は"0"
=countif(セル,"*株式会社*"))


> > エクセルの標準機能もイチから勉強し直します。
> おかげさまでExcel標準のデータベース関数を勉強する機会を得ました。
> 条件設定した集計は、Excel標準のSumifs関数を先に知ったので、小川先生と同じ集計をSumifs関数で実装してみました。

たかちゃんさん:

> エクセルの標準機能もイチから勉強し直します。
おかげさまでExcel標準のデータベース関数を勉強する機会を得ました。
条件設定した集計は、Excel標準のSumifs関数を先に知ったので、小川先生と同じ集計をSumifs関数で実装してみました。

Sub sumifs_sample()
    'SumIfs関数でDsum関数と同じことをしてみた by Tanaka
    Dim sfData As Range '仕入金額
    Dim rData1 As Range '仕入年
    Dim rData2 As Range '仕入月
    Dim rData3 As Range '商品名

    Set sfData = Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row)
    Set rData1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Set rData2 = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    Set rData3 = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
    
    Dim i As Integer, j As Integer, k As Integer
    Dim iYear(1) As Integer, iMonth(11) As Integer, sShohin(2) As String
    iYear(0) = 2005
    iYear(1) = 2006

    For j = LBound(iMonth) To UBound(iMonth)
        iMonth(j) = j + 1
    Next

    sShohin(0) = "あま酒"
    sShohin(1) = "ふりかけ"
    sShohin(2) = "みそピー"
    
    Dim gyo As Integer
    
    '仕入年月ごと、商品ごとの仕入額総計
    gyo = 6
    For i = LBound(iYear) To UBound(iYear)
        For j = LBound(iMonth) To UBound(iMonth)
            For k = LBound(sShohin) To UBound(sShohin)
                Range("I" & gyo).Value = iYear(i) & "年"
                Range("J" & gyo).Value = iMonth(j) & "月"
                Range("K" & gyo).Value = sShohin(k)
                Range("L" & gyo).Value = _
                WorksheetFunction.SumIfs(sfData, rData1, iYear(i), rData2, iMonth(j), rData3, sShohin(k))
                gyo = gyo + 1
            Next
        Next
    Next
End Sub

田中 宏明さん:

ありがとうございます！
実はキャンセル判定ずっと方法を考えていたのですが
答えを見つけられずにいました。。

こうやって、VBA業務の経験者とやり取りできる機会を与えてもらい
感謝しかありません。早速、試してみます！

> 私からは、他人がツールを使う場合の対策を紹介します。
> Application.InputBox　だと　Type:=1 指定で、数字だけを受け付けるようにできます。
> ただし、キャンセルの場合、Falseが返るので、Variant型に変更したうえでVarTypeメソッドで変数のデータ型の分類を含む Integer 値を調べ、キャンセルを判定させています。

小川慶一さん:

先生、サンプルコード読みました。
読み終わった時は、凄すぎて言葉が出ませんでした。

Excelがここまで凄かったとは・・。
サンプルコードは、まさに実現したかった事です。
エクセルの標準機能もイチから勉強し直します。
毎回、本当にありがとうございます！

> 参考までに紹介すると、条件設定しての値取得には、ワークシート関数のDSum DCount 等のデータベース関数群が便利です。

たかちゃん

> 相変わらず、すばらしいですね。
ホントすばらしです。

私からは、他人がツールを使う場合の対策を紹介します。
Application.InputBox　だと　Type:=1 指定で、数字だけを受け付けるようにできます。
ただし、キャンセルの場合、Falseが返るので、Variant型に変更したうえでVarTypeメソッドで変数のデータ型の分類を含む Integer 値を調べ、キャンセルを判定させています。

    Dim ans As Variant 'キャンセル対応でVariant型に変更
    ans = Application.InputBox(Prompt:="数字を入力して下さい" & vbCrLf & "セッション：5" & _
    vbCrLf & "ページビュー：7" & vbCrLf & "カートボックス獲得率：9" & _
    vbCrLf & "商品購入率：11" & vbCrLf & "注文商品売上：12", Title:="データ集計", Type:=1)
 
    If VarType(ans) = vbBoolean Then
        MsgBox "キャンセルされました。"
        Exit Sub
    ElseIf ans <> 5 And ans <> 7 And ans <> 9 And ans <> 11 And ans <> 12 Then
        MsgBox "集計できません"
        Exit Sub
    End If

　…途中略…

    '値を表の中に書き出し
    CreateValue CLng(ans)  'Long型にキャストして渡す必要あり
 

ピボットテーブルのような動きのマクロ

Option Explicit

    Dim wsSaki As Worksheet
    Dim wsMoto As Worksheet
    
Public Sub CreateGraph()
    Dim ar() As Variant
    Dim ans As Long '調べたいデータ
    
    Set wsSaki = ThisWorkbook.Worksheets("graph")
    Set wsMoto = ThisWorkbook.Worksheets("data")
    
    ans = InputBox("数字を入力して下さい" & vbCrLf & "セッション：5" & _
    vbCrLf & "ページビュー：7" & vbCrLf & "カートボックス獲得率：9" & _
    vbCrLf & "商品購入率：11" & vbCrLf & "注文商品売上：12", "データ集計", "")


    If ans <> 5 And ans <> 7 And ans <> 9 And ans <> 11 And ans <> 12 Then
        MsgBox "集計できません"
        Exit Sub
    End If

    '初期化
    wsSaki.Range("A1").CurrentRegion.ClearContents
    '横軸（日付）の書き出し
    ar() = CreateAxis("A", "B")
    '貼り付け
    wsSaki.Range("A1").Resize(UBound(ar, 2), UBound(ar, 1)).Value = _
    Application.WorksheetFunction.Transpose(ar)
    
    Erase ar
    
    '縦軸（商品番号）の書き出し
    ar() = CreateAxis("C", "B")
    '貼り付け
    wsSaki.Range("A1").Resize(UBound(ar, 1), UBound(ar, 2)).Value = ar
    
    '値を表の中に書き出し
    CreateValue ans
    
End Sub

Private Sub CreateValue(ans As Long)

    Set wsSaki = ThisWorkbook.Worksheets("graph")
    Set wsMoto = ThisWorkbook.Worksheets("data")
    
    Dim vlist As Variant
    Dim Col As Long
    Dim Lrow As Long
    Dim c As Long
    Dim gyo As Long
    Dim retsu As Long
    
    'データを一気に配列に格納
    vlist = wsMoto.Range("A1").CurrentRegion
    '最終列を調査
    Col = wsSaki.Range("A1").End(xlToRight).Column - 2
    '最終行を調査
    Lrow = wsSaki.Range("A" & Rows.Count).End(xlUp).Row - 2
    
    For c = LBound(vlist, 1) + 1 To UBound(vlist, 1)
        For gyo = 0 To Lrow
        If Range("A2").Offset(gyo).Value = vlist(c, 3) Then
            For retsu = 0 To Col
            If Range("B1").Offset(, retsu).Value = vlist(c, 1) Then
                Range("B2").Offset(gyo, retsu).Value = vlist(c, ans) '調べたい値が入力
                Exit For
            End If
            Next
        Exit For
        End If
        Next
    Next

    
End Sub

Function CreateAxis(R1 As String, R2 As String) As Variant()
    Dim arDate() As Variant

    Set wsSaki = ThisWorkbook.Worksheets("graph")
    Set wsMoto = ThisWorkbook.Worksheets("data")
    
    Dim lastR As Long
    
    'データをコピーし貼り付け
    lastR = wsMoto.Range(R1 & Rows.Count).End(xlUp).Row
    'A列日付の貼り付け
    wsMoto.Range(R1 & "1:" & R1 & lastR).Copy
    'とりあえず関係無い所B3に書き出している
    wsSaki.Range(R2 & "3").PasteSpecial xlPasteValues
    
    '重複データを除去
    lastR = wsSaki.Range(R2 & Rows.Count).End(xlUp).Row
    wsSaki.Range(R2 & "3:" & R2 & lastR).RemoveDuplicates Columns:=1, Header:=xlYes
    
    '配列に格納
    lastR = wsSaki.Range(R2 & Rows.Count).End(xlUp).Row
    arDate = wsSaki.Range(R2 & "3:" & R2 & lastR).Value
    wsSaki.Range(R2 & "3:" & R2 & lastR).ClearContents
    
    CreateAxis = arDate()
    
End Function

 

CSVデータをまとめるマクロ

Option Explicit

'dataという名前のワークシートを予め作成しておいて下さい
Public Sub PasteCsvData()
    Dim fs As New Scripting.FileSystemObject
    Dim file As Scripting.file
    Dim files As Scripting.files
    Dim vlist() As Variant
    Dim gyo As Long
    Dim cnt As Long 'カウント用
    cnt = 1
    Dim wsData As Worksheet 'csvデータ書き込み先
    Dim fName As String
    
    Set wsData = Workbooks("BusinessReport.xlsm").Worksheets("data")
    
    
    '-----------------------------------------
    
     MsgBox "CSVファイルが保存されているフォルダを選択してください。"
    '[1]FileDialogオブジェクトを使う方法
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            Set files = fs.GetFolder(.SelectedItems(1)).files
        Else
            Exit Sub
        End If
    End With
    '[2]ファイル拡張子でcsvを判定
    For Each file In files
        If LCase(fs.GetExtensionName(file)) <> "csv" Then
            MsgBox "CSVファイル以外のファイルが含まれるため実行できません。"
            Exit Sub
        End If
    Next
    
  '-----------------------------------------
    
    For Each file In files
        
        'ファイルを開く
        Workbooks.Open (file)
        
        fName = Right(fs.GetBaseName(file), 8) 'ファイル名の日付部分のみを取得

        'csvデータを配列に格納し、その後書き出す
        gyo = wsData.Range("B" & Rows.Count).End(xlUp).Row

        '1回目はタイトル行含む
        If cnt = 1 Then
            vlist = Range("A1").CurrentRegion
            wsData.Range("B1").Resize(UBound(vlist, 1), UBound(vlist, 2)).Value = vlist
            wsData.Range("A1").Value = "日付"
            wsData.Range("A2" & ":A" & wsData.Range("B" & Rows.Count).End(xlUp).Row).Value = fName
        Else
        '2回目以降はタイトル行を除く
            vlist = Range("A1").CurrentRegion.Offset(1, 0).Resize(Range("A1").CurrentRegion.Offset(1, 0).Rows.Count - 1)
            wsData.Range("B" & gyo + 1).Resize(UBound(vlist, 1), UBound(vlist, 2)).Value = vlist
            wsData.Range("A" & gyo + 1 & ":A" & wsData.Range("B" & Rows.Count).End(xlUp).Row).Value = fName
        End If
        ActiveWorkbook.Close
        cnt = cnt + 1
    Next
    
   Set file = Nothing
   Set fs = Nothing
    
End Sub
 

CSVのデータ分析について、マクロを書きました。Excel2019動作確認済み。（記念投稿）

【概要】
毎日、通販の販売状況がCSVで吐き出される。
CSVの中身
A列　親－商品番号
B列　子－商品番号
C列　商品名（商品名は長い。）
D列　セッション（ユーザ訪問数）
E列　セッションのパーセンテージ
F列　ページビュー
G列　ページビュー率
H列　カートボックス獲得率
I列　注文された商品点数
J列　商品購入率
K列　注文商品売上（円）
L列　注文品目総数
CSVのファイル名には日時を含む。

【マクロで実現すること】
１つめのマクロ：
特定のフォルダに複数CSVを格納し、dataシートへデータを転記。
１行名は見出し。（日付、商品名・・・）
２行目以降はデータを転記
A列はファイル名から日付を取得し転記
B列以降は、上記の親ー商品番号～注目品目総数まで転記

２つめのマクロ：
ピボットテーブルで実現可能ですが、マクロで同様の動作を実現。
何の値を集計したいのか、ユーザに選択してもらう
dataシートにあるデータを一気に配列に格納
graphシートに必要なデータを以下のように転記

表の軸を作成（セルB1から横へ日付、A2から下へ商品番号）
表の中は、集計したい値を転記
　
20-10-1　　20-10-2　　20-10-3・・・
A123
A456
A789
・
・
・

今回、グラフ作成のマクロはつけていません。

【感想】
結局書き直してみた所、発展２の知識だけで書くことができました。
マクロ作成が簡単なので便利だと思いました。(^^)

小川先生、田中さん

おはようございます。

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

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

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

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

たかちゃんさん:

> 複数のCSVファイルを自動で読み込ませるマクロを書いてみました。
>
> とても長いのでコメントは気になさらないで下さい(^^)

お疲れさまです。
CSVファイルを正確にExcelへ取り込む場合、落とし穴がたくさんありそうですね。
汎用性を高めるため、フォルダをユーザーに選択させる改良を行ってみました。

'Microsoft Scripting Runtimeにチェックを入れる→FileSystemObjectを使用する為
'Microsoft ActiveX Data Objects x.x にチェックを入れる→ADODB.Streamを使用する為
Public Sub CSVファイルをdataシートへ全て書き出し_Tanaka()
    '以下の改良を行った by Tanaka
    '  [1]フォルダをユーザーに選択させる
    '  [2]選択したフォルダの中にCSVファイル以外が含まれる場合は実行中止

    Dim fs As New Scripting.FileSystemObject
    Dim files As Scripting.files
    Dim file As Scripting.file
    Dim strLine As String
    Dim sData As String
    Dim SPcsvData As Variant
'    Dim path As String
    Dim fName As String
    Dim cnt As Long
    Dim ar() As Variant
    Dim c As Long
    'utf-8(BOM有) csvファイルの文字化け対策用
    Dim ado_stream As New ADODB.Stream
    
    MsgBox "CSVファイルが保存されているフォルダを選択してください。"
    '[1]FileDialogオブジェクトを使う方法
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            Set files = fs.GetFolder(.SelectedItems(1)).files
        Else
            Exit Sub
        End If
    End With
    '[2]ファイル拡張子でcsvを判定
    For Each file In files
        If LCase(fs.GetExtensionName(file)) <> "csv" Then
            MsgBox "CSVファイル以外のファイルが含まれるため実行できません。"
            Exit Sub
        End If
    Next
    'CSVファイルは、BusinessReportフォルダの中へ保存しておく
    'path = ThisWorkbook.path & "\BusinessReport"
    'Set files = fs.GetFolder(path).files

    cnt = 0 '配列で使用するカウント用
    For Each file In files
        'utf-8 csv文字化け対策
        With ado_stream
            .Charset = "utf-8"
            .LineSeparator = 10 '改行されなかったので設定変更
            .Open
            .LoadFromFile (file)
        
            fName = Right(fs.GetBaseName(file), 8) 'ファイル名の日付部分のみを取得、この先の配列0に入れる
            
             ado_stream.SkipLine '1行目(タイトル行)は読まない
            'CSVファイルを2行目から1行づつ読み、ar配列へ格納
            Do Until .EOS
                strLine = .ReadText(adReadLine) '一行読む
                sData = replaceColon(strLine) '\3,000のカンマも区切りと判断される為、区切りのカンマだけ：に置換
                SPcsvData = Split(sData, ":")
                
                ReDim Preserve ar(12, cnt)
                ar(0, cnt) = fName 'ファイル名から取得した日付を配列に格納
                
                'CSVの中の12項目も配列に格納
                For c = LBound(SPcsvData) To UBound(SPcsvData)
                    ReDim Preserve ar(12, cnt)
                    ar(c + 1, cnt) = Mid(SPcsvData(c), 2, Len(SPcsvData(c)) - 2) 'データが""で囲われているので除去
                Next
                           
                cnt = cnt + 1
            Loop
        
            .Close 'ファイルを閉じる
        End With
    Next
    
    '何かデータが入っていた時の為に、一度セルのデータを消去
    Worksheets("data").Range("A1").CurrentRegion.ClearContents
    
    '読み込んだCSVファイルのデータを一気に書き出し
    Worksheets("data").Range("A1").Resize(UBound(ar, 2) + 1, UBound(ar, 1) + 1).Value = _
    Application.WorksheetFunction.Transpose(ar) 'Excel関数で行列入替
    
    Set file = Nothing
    Set files = Nothing
    Set fs = Nothing
End Sub

複数のCSVファイルを自動で読み込ませるマクロを書いてみました。
・csv内には日付データがない為、ファイル名から日付を取得
・csv内の12項目＆日付を配列に入れ、一気にシートに書き出し

csvファイルはこのような感じです。
"ABC1230","掃除機","\6,000"...
EmEditorで確認した所、utf-8(BOM有)

苦労した点
・金額の,が区切り文字と判断される
→replaceColonという関数を作成し、区切りのカンマのみ
":"(コロン)に置き換えた
・データを配列に入れ、エクセルに書き出すと文字化け
→FileSystemObjectの代わりに、ADODB.streamを使用して
CSVを読ませた
・CSV内の改行が認識されなかった
→ADODB.streamのLineSeparatorの値をデフォルトから変更

ほぼ丸一日かかって書き上げ、動いた時は非常に嬉しかった為
記念投稿します。
とても長いのでコメントは気になさらないで下さい(^^)

今度は、データを使用しどのように分析する為のグラフを作ろう・・
と考えてます。ここはVBAと関係ありませんが、。
マクロは奥が深いです。

【参考URL】
https://tonari-it.com/vba-csv-camma/
https://tonari-it.com/vba-csv-utf8/

'Microsoft Scripting Runtimeにチェックを入れる→FileSystemObjectを使用する為
'Microsoft ActiveX Data Objects x.x にチェックを入れる→ADODB.Streamを使用する為
Public Sub CSVファイルをdataシートへ全て書き出し()
    Dim fs As New Scripting.FileSystemObject
    Dim files As Scripting.files
    Dim file As Scripting.file
    Dim strLine As String
    Dim sData As String
    Dim SPcsvData As Variant
    Dim path As String
    Dim fName As String
    Dim cnt As Long
    Dim ar() As Variant
    Dim c As Long
    'utf-8(BOM有) csvファイルの文字化け対策用
    Dim ado_stream As New ADODB.Stream
    
    'CSVファイルは、BusinessReportフォルダの中へ保存しておく
    path = ThisWorkbook.path & "\BusinessReport"
    Set files = fs.GetFolder(path).files
    
    
    cnt = 0 '配列で使用するカウント用
    For Each file In files
         
        'utf-8 csv文字化け対策
        With ado_stream
            .Charset = "utf-8"
            .LineSeparator = 10 '改行されなかったので設定変更
            .Open
            .LoadFromFile (file)
        
        fName = Right(fs.GetBaseName(file), 8) 'ファイル名の日付部分のみを取得、この先の配列0に入れる
        
         ado_stream.SkipLine '1行目(タイトル行)は読まない
        'CSVファイルを2行目から1行づつ読み、ar配列へ格納
        Do Until .EOS
            strLine = .ReadText(adReadLine) '一行読む
            sData = replaceColon(strLine) '\3,000のカンマも区切りと判断される為、区切りのカンマだけ：に置換
            SPcsvData = Split(sData, ":")
            
            ReDim Preserve ar(12, cnt)
            ar(0, cnt) = fName 'ファイル名から取得した日付を配列に格納
            
            'CSVの中の12項目も配列に格納
            For c = LBound(SPcsvData) To UBound(SPcsvData)
                ReDim Preserve ar(12, cnt)
                ar(c + 1, cnt) = Mid(SPcsvData(c), 2, Len(SPcsvData(c)) - 2) 'データが""で囲われているので除去
            Next
                       
            cnt = cnt + 1
        Loop
    
        .Close 'ファイルを閉じる
        End With
        
            
    Next
    
    '何かデータが入っていた時の為に、一度セルのデータを消去
    Worksheets("data").Range("A1").CurrentRegion.ClearContents
    
    '読み込んだCSVファイルのデータを一気に書き出し
    Worksheets("data").Range("A1").Resize(UBound(ar, 2) + 1, UBound(ar, 1) + 1).Value = _
    Application.WorksheetFunction.Transpose(ar) 'Excel関数で行列入替
    
    Set file = Nothing
    Set files = Nothing
    Set fs = Nothing
    
End Sub

Function replaceColon(str As String) As String
    Dim strTemp As String
    Dim quotCount As Long
    Dim L As Long

    For L = 1 To Len(str)
        strTemp = Mid(str, L, 1) '1文字づつ調べる
        If strTemp = """" Then 'ダブルコーテーション(")を単なる記号として扱いたいときは「""」と2つ続けて書く。
            quotCount = quotCount + 1
        ElseIf strTemp = "," Then
            If quotCount Mod 2 = 0 Then
            str = Left(str, L - 1) & ":" & Right(str, Len(str) - L)
            End If
        End If
    Next

    replaceColon = str
End Function
 

たかちゃんさん:

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

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

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

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

田中 宏明さん:

いつもありがとうございます！
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　の書き忘れ以外は完璧だと思います。
>
> お遊びですが、配列からセルへの書き戻しをシンプルにし、変数の数も減らしてみました。

たかちゃんさん:

すごいですね。
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の行の日時と気温データを取得しグラフを作成する
> マクロを作成してみました。

気象庁のページから以下の条件で、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

 

小川慶一さん:

Windows環境を準備し、再びここまで辿り着きました。

前回の動画辺りから新しく覚えることも増え、とても大変ですが
Mac環境で同じプログラムを書こうと四苦八苦していた前回に
比べたら・・・理解度は雲泥の差です。

因みに、MacのBootCampを使用し、外付けHDにWindowsをインストール
して使っています。この環境を準備するのにもかなり苦労しましたが、、。もっと早くWindows環境を準備すれば良かったと思いました。

> たかちゃんさん:
>
> 一般論としては、環境を本番に寄せたほうがトレーニングはより効果的にできます。

小川慶一さん:

そうなんですね。ありがとうございます。
ここ最近調べていて、さすがにこのレベルまで来るとMacOSでは限界が
あるなぁとは薄々気づき始めました。(^^;
今後もエクセルやオフィスを中心とした仕事になりそうなので、Windows環境を用意する方向でいこうと思います。

> たかちゃんさん:
>
> エクセルVBAは、「Windowsありき、Windows上で動作するエクセルありき」という前提で開発されたプログラミング言語です。
> 他の選択肢はPython等いろいろありますが、最初からOSの制約なく動くように開発されたプログラミング言語であれば、こういう悩みは生じにくいです。
>

小川慶一さん:
Pythonではそういう使い方ができるのですね。実は今までずっとWindowsユーザで、最近Macを使うようになりました。
Pythonについては良く知らないのですが、ネットを見ていると結構使っている人が多そうです。新講座、とても楽しみです。

> (Python講座は、来年にはウチでもかなり充実されられるかと思っています)
>

田中さん:

日々新しいことを学ぶ度に、嬉しくて思わず呟いていました。
こんな呟きコメントでしたが、返信をコメントを頂いて本当にありがとうございます。頂いたコードは、Macで正常に動作しました！ネットで調べながら読みときました。
テキストデータを配列に入れる所、Getの所で出てきたバイナリファイルについて等、とても勉強になりました。バイナリデータには、アプリケーション固有の情報が色々格納されるとのこと。（エクセルだったらセルの書式とか図形の位置など。）今のレベルでは具体的な使い方までは思いつきませんが、外部連携の講座のどこかでこの知識はとても役に立ちそうです。いつもアドバイスして頂き、本当にありがとうございます！(^^)


> たかちゃんさん:
>
> いつの間にか外部連携講座に進まれていたのですね。
>
> Openステートメントでテキストファイルを一気に読み込む裏技もあります。バイナリモードで開き、テキストファイルに変換します。
> よろしけば Macで動作するかどうか試してみてください。

たかちゃんさん:

いつの間にか外部連携講座に進まれていたのですね。

Openステートメントでテキストファイルを一気に読み込む裏技もあります。バイナリモードで開き、テキストファイルに変換します。
よろしけば Macで動作するかどうか試してみてください。

Sub ReadTextFileBinary()
 
    Dim FileNum As Long   'ファイルを開く為に使う番号を格納する
    Dim MYPath As String  'ファイルのパスを格納
    Dim buf() As Byte     'バイナリデータ処理用
    
    'デスクトップへのパスを設定
    MYPath = MacScript("return (path to desktop folder) as String")
    
    'デスクトップ上にある、対象のTextファイルのパスを設定
    MYPath = MYPath & "textfile1.txt"
 
    'FreeFile関数にてファイルを開くための番号を取得
    FileNum = FreeFile()
 
    'Open ファイル名 For 開き方 As #ファイル番号
    Open MYPath For Binary As #FileNum
                    '↑バイナリモードで開く

    'ファイルの長さを取得し、変数bufの大きさを確保する
    ReDim buf(1 To LOF(FileNum))

    Get #FileNum, , buf 'ファイルを変数bufに読み込む
    Close #FileNum      'ファイルを閉じる

    Debug.Print StrConv(buf, vbUnicode)
    
    Erase buf '用済みのため初期化
End Sub 

> 今使えるPCがMacしかないので、お手本通りに行きませんが、
> どうしてもMacでも動かしてみたいと調べて、本日やっと
> 成功しました。とても嬉しかったので、近況報告しました。
> （Excel for Mac 2016で動作確認済み）

FileSystemObjectで行っていたことをMacOSでする方法を調べて、なんとか実現できました。
感想：OSの中のライブラリフォルダーにファイルをコピーしないといけない時点で、仕事で使うには不向きだと思いました。また、プログラムを呼び出している所がvbaのFunctionのようだと思いました。なんとなく基本が見えてきたので、これでWindowsとMacと比べながら勉強できそうです。

＜方法>
１.FileSystemObjectで作業している箇所は、AppleScriptTaskというMacOS版バッチファイルのようなプログラムで書く。
２．そのファイルを、MacOS内のライブラリフォルダの中へ設置。
３．Excel vbaでは、そのスクリプトファイルと、ハンドラー（メソッドみたいなもの）、ファイルの場所を指定しておく。

・デスクトップ上に、MacTestFile.xlsmファイルがあるか無いかを調べる方法

１．Macにあるスクリプトエディタと言うメモ帳みたいなもので、このコードをコピーしてを名前をつけて保存。（ここでは仮にMyFileTest.scpt）
保存先はMac OSの中のライブラリフォルダの中のcom.microsoft.Excelフォルダの中へ、普通にドラッグ&ドロップで
MyFileTest.scptをコピーしておく。

on ExistsFile(filePath)
	--check if file exists and type is file
	tell application "System Events" to return (exists disk item filePath) and class of disk item filePath = file
end ExistsFile 

２．エクセルvbaの画面では、コードを以下のようにして実行。

Sub TestFile()
    Dim RunMyScript As Boolean
    Dim FilePathName As String
    
    FilePathName = "/Users/ユーザ名/Desktop/MacTestFile.xlsm"
    
    RunMyScript = AppleScriptTask("MyFileTest.scpt", "ExistsFile", FilePathName)
    If RunMyScript = True Then
        MsgBox "File exists"
    Else
        MsgBox "File not exists"
    End If
End Sub 

参考サイト：
https://www.rondebruin.nl/mac/applescripttask.htm
https://qiita.com/negiboudu/items/5010dfc05886a576457b

外部連携講座に入ってから、一気にレベルが上がりました。
頭から煙が出そうですが、少しづつ仕組みを思い浮かべながら、
ノートに書いてみたりしながら、少しづづ進んでいます。


今使えるPCがMacしかないので、お手本通りに行きませんが、
どうしてもMacでも動かしてみたいと調べて、本日やっと
成功しました。とても嬉しかったので、近況報告しました。
（Excel for Mac 2016で動作確認済み）

Sub ReadTextFile()

    Dim FileNum As Long 'ファイルを開く為に使う番号を格納する
    Dim DataLine As String 'ファイル内の文字を一時的に格納
    Dim MYPath As String 'ファイルのパスを格納

	'デスクトップへのパスを設定
    MYPath = MacScript("return (path to desktop folder) as String")
	'デスクトップ上にある、対象のTextファイルのパスを設定
    MYPath = MYPath & "textfile1.txt"

	'FreeFile関数にてファイルを開くための番号を取得
    FileNum = FreeFile()

	'Open ファイル名 For 開き方 As #ファイル番号　Input（読み込み）で開くの意味
    Open MYPath For Input As #FileNum

    'ファイルがEOF(ファイルの終端)になるまでループをする
    Do Until EOF(FileNum)
		'Line Input #番号, 変数 (1行づつ読み込む)
        Line Input #FileNum, DataLine
		
        Debug.Print DataLine

    Loop
    'ファイルを閉じる
    Close #FileNum
End Sub 

参考サイト：
https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_mac-mso_mac2016/read-text-file-line-by-line-using-vba-on-mac/7173f9dd-622d-432a-a960-816f0e734e96
https://www.petitmonte.com/excel/excel_vba_freefile.html

久しぶりに仕事でテキストファイルの処理を行いました。
具体的には、あるフォルダに保存された複数CSVファイルを１つのCSVファイルに結合するツール作成。
配列を利用することでWorkSheet不要の処理となりました。
　①複数CSVファイルを順番にOpenTextFileメソッドで開き、TextStreamのReadLineメソッドで行データを一次元配列に格納
　②別のCSVファイルをOpenTextFileメソッドで作成
　③一次元配列に格納された行データをTextStreamのWriteLineメソッドで②のCSVファイルに追記

csvファイルを読み込んだ直後に配列に代入した実際のコードです。
小川先生:

VIP向け新講座、とても楽しみです。
実際のコードもぜひ見てください。（添削は不要です。）

Set TS = FSobj.OpenTextFile(Filename:=sDir & "\" & answerFile(Fcnt), IOMode:=ForReading, Create:=False, Format:=TristateUseDefault)

'改行コードで区切り、配列に代入。配列は行ごとのデータになる。
Records = Split(TS.ReadAll, vbNewLine)

外部連携講座は、かなり奥が深いですが、この
テキストファイルの操作は、急にレベルが高く
なったように感じたので、理解を深めるまでに
相当な時間がかかりました。

今では、FileSystemObject TextStreamを使い、
csvファイル(カンマで区切られたデータ）を
読み込んだ直後に配列に代入し、高速にデータ
処理できるまになりました。

達人養成塾に入って、２年半での成果報告です。

AtEndOfLine と streamについて、
動画内での説明と字幕での説明が違いますが
結局はどちらなのでしょうか。
混乱するので動画の再編集をしていただければ
有り難いかなと思いますが。

理解できました。

小川先生

丁寧な説明をありがとうございます。

納得することができました。

「Do Until txt.AtEndOfStream」で読み込むとテキストファイルの中身全て（広瀬川.....萩原朔太郎）が読み込まれますが、「Do Until txt.AtEndOfLine」にすると「広瀬川.....もとまらず。」と最後の1行が読み込まれませんが、どういった違いなのでしょうか?

 Sub ReadText2()
    Dim fs As Scripting.FileSystemObject
    Dim txt As TextStream
    Dim path As String
    Dim stEachline As String
    
    path = ThisWorkbook.path & "\fsosample\textfile1.txt"
    Set fs = New Scripting.FileSystemObject
    
    Set txt = fs.OpenTextFile(filename:=path, IOMode:=ForReading, create:=True, _
        Format:=TristateUseDefault)
    
    Do Until txt.AtEndOfStream
        stEachline = txt.ReadLine
        Debug.Print stEachline
    Loop

    txt.Close
    Set txt = Nothing
    Set fs = Nothing
End Sub