テキストファイルの操作について

この講座は有料講座です。
講座の購入後ご覧になれます。

ログインアカウントの新規作成

解説

テキストファイルの操作方法について説明しています。

この教材についての過去の質問・感想

12878 : 小川慶一の回答 (2021-01-27 08:31:17)

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

おはようございます。

ありがとうございます。
DSumよりSumIfsのほうが計算のためにセルに条件を記載する必要がない分良さそうですね。

> 一方、小川先生の講座は、...、最初は条件分岐や繰り返しのコードを学び

これは、ホントそうです。
便利なショートカット技をどんなにたくさん知ったとしても、条件分岐や繰り返しのコードからは逃げられないです。
一方、条件分岐や繰り返しのコードをきちんと書けると、ショートカット技を知らなくてもたいていの計算は自力でできます。


12873 : たかちゃんさんのコメント (2021-01-25 02:48:47)

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

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


12872 : 田中 宏明さんのコメント (2021-01-24 21:56:12)

たかちゃんさん:

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

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


12871 : たかちゃんさんのコメント (2021-01-24 21:36:16)

田中 宏明さん:

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

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

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

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


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


12868 : 田中 宏明さんのコメント (2021-01-24 09:14:28)

たかちゃんさん:

> エクセルの標準機能もイチから勉強し直します。
おかげさまで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


12865 : 小川慶一の回答 (2021-01-23 14:13:02)

田中 宏明さん:

興味深いです。

intputbox と excel の application.inputbox は別物なんですね。
Type:=1 て、正直、はじめてこの引数の存在を認識しました。

InputBox 関数
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/inputbox-function

Application.InputBox メソッド (Excel)
https://docs.microsoft.com/ja-jp/office/vba/api/excel.application.inputbox

Inputboxでは、「想定内の値が入力されるまでしつこくダイアログを表示したい」というのもよくあるニーズです。
そういうときは、 Do Loop 内にinputbox表示のコードを入れて、所望の値を入力されるまでLoopをくり返すというやり方もあります。

ということで、以下、少しリライトしてみました。

もっとも、しっかり作り込むなら、ユーザフォームを作って、有効な選択肢のみをラジオボタン表示するのが良いでしょう。

Sub hoge()
    Dim ret As Variant
    Dim bOk As Boolean
    bOk = False
    Do
        ret = Application.InputBox(Prompt:="5, 7, 9, 11, 12 のどれかを入力してください", Type:=1)
        Select Case LCase(TypeName(ret))
            Case "boolean"
                MsgBox "キャンセルされました"
                Exit Sub
            Case Else ' "double"
                Select Case CInt(ret)
                    Case 5, 7, 9, 11, 12
                        bOk = True
                    Case Else
                        bOk = False
                End Select
            End Select
    Loop Until bOk
    Debug.Print ret
End Sub

'メインの処理を簡潔にしたバージョン
Sub fuga()
    Const prompt_string As String = "5, 7, 9, 11, 12 のどれかを入力してください"
    Dim ret As Variant
    Do
        ret = Application.InputBox(Prompt:=prompt_string, Type:=1)
        If TypeName(ret) = "Boolean" Then
            MsgBox "キャンセルされました"
            Exit Sub
        End If
    Loop Until is_valid(ret)
    Debug.Print ret
End Sub
Function is_valid(ret As Variant) As Boolean
    Select Case ret
        Case 5, 7, 9, 11, 12
            is_valid = True
        Case Else
            is_valid = False
    End Select
End Function


12863 : たかちゃんさんのコメント (2021-01-23 00:46:32)

田中 宏明さん:

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

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

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


12862 : たかちゃんさんのコメント (2021-01-23 00:37:14)

小川慶一さん:

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

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

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


12861 : 田中 宏明さんのコメント (2021-01-22 22:12:40)

たかちゃん

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

私からは、他人がツールを使う場合の対策を紹介します。
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型にキャストして渡す必要あり
 


12860 : 小川慶一の回答 (2021-01-22 11:16:04)

たかちゃんさん:

相変わらず、すばらしいですね。

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

これらの関数は、エクセルVBAからも利用可能です。
以下は、サンプルコードです。
(*サンプルデータの取得は、サンプルコードの後に紹介したリンクからお願いします)

配列の要素はハードコーディングしていますが、実務では、紹介済みの重複しないリストを作成する方法等で動的に取得することになるでしょう。
条件設定をしているセル(I1:K2)は、ユーザから見えないところに置くか、コード内で生成して出力が終わったら削除するか。

Sub dsum_sample()
    Dim rData As Range, rCondition As Range
    Set rData = Range("A1").CurrentRegion
    Set rCondition = Range("I1").CurrentRegion
    
    'DSum関数をworksheetfunctionで使うための動作確認(セルN2に埋め込んだ関数式も参考のこと)
    Debug.Print WorksheetFunction.DSum(rData, "仕入金額", rCondition)
    
    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
    Const cBase As Long = 6
    
    '仕入年ごとの仕入額総計
    gyo = cBase
    rCondition.Offset(1).Clear
    For i = LBound(iYear) To UBound(iYear)
        Range("I2").Value = iYear(i)
        Range("I" & gyo).Value = iYear(i) & "年"
        Range("J" & gyo).Value = WorksheetFunction.DSum(rData, "仕入金額", rCondition)
        gyo = cBase + 1
    Next

    '仕入年ごと、商品ごとの仕入額総計
    gyo = gyo + 2
    rCondition.Offset(1).Clear
    For i = LBound(iYear) To UBound(iYear)
        Range("I2").Value = iYear(i)
        For k = LBound(sShohin) To UBound(sShohin)
            Range("K2").Value = sShohin(k)
            Range("I" & gyo).Value = iYear(i) & "年"
            Range("J" & gyo).Value = sShohin(k)
            Range("K" & gyo).Value = WorksheetFunction.DSum(rData, "仕入金額", rCondition)
            gyo = gyo + 1
        Next
    Next

    '仕入年月ごと、商品ごとの仕入額総計
    gyo = gyo + 2
    rCondition.Offset(1).Clear
    For i = LBound(iYear) To UBound(iYear)
        Range("I2").Value = iYear(i)
        For j = LBound(iMonth) To UBound(iMonth)
            Range("J2").Value = iMonth(j)
            For k = LBound(sShohin) To UBound(sShohin)
                Range("K2").Value = sShohin(k)
                Range("I" & gyo).Value = iYear(i) & "年"
                Range("J" & gyo).Value = iMonth(j) & "月"
                Range("K" & gyo).Value = sShohin(k)
                Range("L" & gyo).Value = WorksheetFunction.DSum(rData, "仕入金額", rCondition)
                gyo = gyo + 1
            Next
        Next
    Next
End Sub


https://www.dropbox.com/s/5tskwgme88cdm22/dsum_sample.xlsm?dl=0


12859 : たかちゃんさんのコメント (2021-01-22 02:38:57)

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

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

 


12858 : たかちゃんさんのコメント (2021-01-22 02:33:16)

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
 


12857 : たかちゃんさんのコメント (2021-01-22 02:30:38)

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

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

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

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

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




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

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


12847 : 小川慶一の回答 (2021-01-18 05:27:12)

たかちゃんさん:

おはようございます。
手段の引き出しが多いのはとても良いかと (^^

ひきつづき、よい学びを☆


12845 : たかちゃんさんのコメント (2021-01-17 22:32:33)

小川先生、田中さん

おはようございます。

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

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

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

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


12841 : 小川慶一の回答 (2021-01-17 10:56:33)

たかちゃんさん:

エクセル標準機能のファイルの読み込みウィザードは試されましたでしょうか。
リボンの[データ]→[データの取得」や[テキストまたはCSVから]です。
自動記録をしつつこれらを使ってファイルを読み込みます。文字コードやCSVの書式の問題はある程度解決してくれます。

あとは、ベタに、 workbooks.open(some_csv_path) と、CSVファイルをエクセルファイルのように開いてしまう。
「これでちゃんと動けば儲けもの」ということで。


12840 : 小川慶一の回答 (2021-01-17 10:18:33)

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

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

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

[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


12839 : 田中 宏明さんのコメント (2021-01-17 09:57:36)

たかちゃんさん:

> 複数の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


12837 : たかちゃんさんのコメント (2021-01-17 08:20:56)

複数の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
 


12834 : 田中 宏明さんのコメント (2021-01-16 08:08:40)

たかちゃんさん:

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

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

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

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


12831 : たかちゃんさんのコメント (2021-01-15 23:26:35)

田中 宏明さん:

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


12830 : 田中 宏明さんのコメント (2021-01-15 18:33:08)

たかちゃんさん:

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


12827 : たかちゃんさんのコメント (2021-01-15 12:24:59)

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

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

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

マクロの動き
1.9:00の行のデータのみ取得。
2.配列に格納
3.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 &lt;> 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

 


12682 : 小川慶一の回答 (2020-12-15 10:23:14)

たかちゃんさん:

おはようございます。
いろいろ楽しんでください。体験することがいちばんよい学びです☆


12681 : たかちゃんさんのコメント (2020-12-15 03:41:36)

小川慶一さん:

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

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

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

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


12663 : 小川慶一の回答 (2020-12-02 10:03:29)

たかちゃんさん:

一般論としては、環境を本番に寄せたほうがトレーニングはより効果的にできます。
ほかの制約条件との関係もあるでしょうが、今後もエクセルやオフィスを中心とした仕事→Windows環境がメイン、ということでしたら、Windows環境でトレーニングされたほうが良いかと思います。


12662 : たかちゃんさんのコメント (2020-12-01 22:03:17)

小川慶一さん:

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

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


12659 : 小川慶一の回答 (2020-12-01 11:31:08)

たかちゃんさん:

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

もっとも、「では、エクセルでの処理の自動化にはPythonのほうが良いですね!」となると、僕としてはそうは言い難い気がします。
個人的には、エクセルVBAのほうが、エクセル仕事効率化のためのコードを書くのは格段に楽と思います。


12658 : たかちゃんさんのコメント (2020-12-01 00:53:08)

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

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


12654 : 小川慶一の回答 (2020-11-30 10:57:34)

たかちゃんさん:

Macのことは僕はくわしくないのですが、いろいろ興味深いです。
「OS非依存の方法を」ということでしたら、VBA以外でそもそもPythonを使うとかもありそうです。
(Python講座は、来年にはウチでもかなり充実されられるかと思っています)


12651 : たかちゃんさんのコメント (2020-11-30 00:25:14)

田中さん:

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


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


12648 : 田中 宏明さんのコメント (2020-11-29 08:39:05)

たかちゃんさん:

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

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で動作確認済み)


12647 : たかちゃんさんのコメント (2020-11-29 05:33:34)

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

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

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

1.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 


2.エクセル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


12645 : たかちゃんさんのコメント (2020-11-28 03:54:48)

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


今使える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


12550 : 小川慶一の回答 (2020-11-01 05:57:35)

田中 宏明さん:

おはようございます。

エクセルシートへの記入不要なようでしたら、 VBS でもできそうですね。
田中さんなら興味持たれるかとも。トライしてみてください (^^


12542 : 田中 宏明さんのコメント (2020-10-31 18:10:37)

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


10617 : 受講生さんのコメント (2018-10-02 22:42:43)

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

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

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

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


10616 : 小川慶一の回答 (2018-10-02 11:42:24)

受講生 さん:

すいません、お返事漏れていました。

成果報告ありがとうございます。
すばらしい成果、なによりです。

VIP向け新講座も準備中です。楽しみにしていてください。

> 外部連携講座は、かなり奥が深いですが、このテキストファイルの操作は、急にレベルが高くなったように感じたので、理解を深めるまでに相当な時間がかかりました。
> 今では、FileSystemObject TextStreamを使い、csvファイル(カンマで区切られたデータ)を読み込んだ直後に配列に代入し、高速にデータ処理できるまになりました。
> 達人養成塾に入って、2年半での成果報告です。


10598 : 受講生さんのコメント (2018-09-27 19:56:45)

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

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

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


10015 : 小川慶一の回答 (2018-05-21 14:21:37)

受講生 さん:

こちらの件について、続きのコメントです。

改めて調査しました。
とりいそぎお伝えすると、 AtEndStreamを使うことが推奨です。
AtEndOfLineは、空白行が途中にあるとそこで読み込みを中断してしまうので。
追って、サンプルデータを使ったデモの動画を追加したいと考えています。

ひきつづきよろしくお願いいたします。


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


9987 : 小川慶一の回答 (2018-05-16 08:08:37)

受講生 さん:

おはようございます。

お返事遅れました。
事務局に確認させ、早々に修正対応させたいと思います。

また、早いうちにお返事さしあげます。

とりいそぎ、よろしくお願いいたします。


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


9974 : 受講生さんのコメント (2018-05-14 21:48:25)

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


5549 : 山田 将之さんのコメント (2016-01-10 13:19:12)

理解できました。


5367 : 小川慶一の回答 (2015-12-02 08:27:25)

受講生 さん:

よかったです。ひきつづきよろしくお願いいたします。

>小川先生
>
>丁寧な説明をありがとうございます。
>
>納得することができました。


5357 : 受講生さんのコメント (2015-12-01 10:34:46)

小川先生

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

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


5338 : 小川慶一の回答 (2015-11-27 19:29:54)

受講生 さん:

Do Until ... は条件を満たしたところで Do Loop の中身には入りませんから、「Do Until txt.AtEndOfLine」にすると最後の行を取得できた段階で、 Do Loop の中には入らない、つまりスキップされます。

改行よりもテキストストリームの終端のほうが後にありますので、「Do Until txt.AtEndOfStream」にすると最後の改行までも問題なく Do Loop の中で処理されます。

この説明でご理解いただけそうでしょうか?


>「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 


5315 : 受講生さんのコメント (2015-11-24 16:19:48)

「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 


3日がかりのその仕事、3分で終わらせる方法教えます。ガラパゴスタディーオンライン講座 ユーザー登録

本講座の動画一覧

  1. 【動画1】 これから取り扱うトピックを説明
    【動画1】 これから取り扱うトピックを説明 未習得
  2. 【動画2】 クラスとインスタンス、外部ライブラリの参照
    【動画2】 クラスとインスタンス、外部ライブラリの参照 未習得
  3. 【動画3】 「クラス」と「インスタンス」について
    【動画3】 「クラス」と「インスタンス」について 未習得
  4. 【動画4】 クラスの連携について
    【動画4】 クラスの連携について 未習得
  5. 【動画5】 「クラス」と「インスタンス」の生成を体験
    【動画5】  「クラス」と「インスタンス」の生成を体験 未習得
  6. 【動画6】 「New キーワード」と 「固有オブジェクト型での変数宣言とそのメリット」について
    【動画6】 「New キーワード」と 「固有オブジェクト型での変数宣言とそのメリット」について 未習得
  7. 【動画7】 外部ライブラリの参照について1
    【動画7】 外部ライブラリの参照について1 未習得
  8. 【動画8】 外部ライブラリの参照について2
    【動画8】 外部ライブラリの参照について2 未習得
  9. 【動画9】 ファイルの操作・フォルダの操作説明
    【動画9】 ファイルの操作・フォルダの操作説明 未習得
  10. 【動画10】 フォルダ内のサブフォルダとファイルをリストアップ
    【動画10】 フォルダ内のサブフォルダとファイルをリストアップ 未習得
  11. 【動画11】 テキストファイルの操作について
    【動画11】 テキストファイルの操作について 未習得
  12. 【動画12】 文字列操作の一例を紹介
    【動画12】 文字列操作の一例を紹介 未習得
  13. 【動画13】 データベース接続を簡単に実現する外部ライブラリについて
    【動画13】 データベース接続を簡単に実現する外部ライブラリについて 未習得
  14. 【動画14】 データベースとの接続と接続解除について
    【動画14】 データベースとの接続と接続解除について 未習得
  15. 【動画15】 Openメソッドについて
    【動画15】 Openメソッドについて 未習得
  16. 【動画16】 カレントレコードについて
    【動画16】 カレントレコードについて 未習得
  17. 【動画17】 簡単なSQL を使った.mdb ファイルからデータを取得するサンプルについて
    【動画17】 簡単なSQL を使った.mdb ファイルからデータを取得するサンプルについて 未習得
  18. 【動画18】 ORDER BYの紹介
    【動画18】 ORDER BYの紹介 未習得
  19. 【動画19】 データベースの更新について
    【動画19】 データベースの更新について 未習得
  20. 【動画20】 既存レコード内容の削除とデータリンクファイルによる接続について
    【動画20】 既存レコード内容の削除とデータリンクファイルによる接続について 未習得
  21. 【動画21】 Office アプリケーションを操作・連携するには
    【動画21】 Office アプリケーションを操作・連携するには 未習得
  22. 【動画22】 PowerPoint の主要オブジェクト紹介
    【動画22】 PowerPoint の主要オブジェクト紹介 未習得
  23. 【動画23】 Excel の表を貼り付けるには
    【動画23】 Excel の表を貼り付けるには 未習得
  24. 【動画24】 Wordと連携するには
    【動画24】 Wordと連携するには 未習得
  25. 【動画25】 文書中の一文を操作するには
    【動画25】 文書中の一文を操作するには 未習得

塾長 小川慶一

メニュー

コメント紹介

もっと見る

ページの先頭へ