複数の.csvファイルから指定数値を取り出す

質問

お世話になります。

早速質問ですが、Excel VBA環境で

あるフォルダ内の複数の.csvファイル一つ一つから
指定数値(B列6行目のみ)を取り出して、
デスクトップ上、別のExcelシートの(B列１行毎に日付と時間が書いてある)
隣のC列にまとめて自動で書いてくれるプログラムがあればいいな
と考えているのですが、

可能でしょうか。
値をただ吸い出して、別の新規ファイルにまとめて表示してくれるだけでも
助かります。宜しくお願い申し上げます。

回答No.4

eden3616 · ベストアンサー

補足確認しました。

>・フォルダは１つのフォルダです。
>・正確には、20150408100003.csvというファイル名です。
>・合計はせずに、ただ複数CSVファイルの値の数（行数分）だけ時系順に書出す。
>プランA(理想的)
>・「"データ集.xlsx"のB列に日時が書いてある」ので
>C列にB列の日時に合わせた数値を出力する。

プランAで作成しております。最下のVBAコードと差し換えてください。
「データ集.xlsx」の書き出し先シートを表示した状態でマクロを実行してください。
（コードを記述するブックは新規ブック（マクロブック）でも可能）
サンプル結果を画像添付いたします。
（ただし、データ集.xlsxのB列はシリアル値で日付が入力されている条件とします）

出力先のB列とファイル名（日時）との比較は、「年・月・日・時」を使用しております。
以下のような重複した日時がある場合は後から読み込まれたファイルの値で上書きされてしまいます。
問題がある場合は補足願います。

以下のような場合は「4/8 10時」のセルには「10.2」が出力されます。
20150408100001.csv　→　値：10.1
20150408100002.csv　→　値：10.2

■VBAコード

Sub 値取得()
'配列変数を宣言
Dim filnames As Variant
Dim myfile As Variant
Dim cnt As Long
Dim mybook As Workbook
Dim outbook As Worksheet
Dim fname As String
Dim mySerial As Date
Dim myRng As Variant
Dim key As String
'出力先の先頭行番号
cnt = 1
'出力先のブックを格納
Set outbook = ActiveWorkbook.ActiveSheet
'ファイル名を配列変数に格納
filnames = Application.GetOpenFilename("CSVファイル (*.csv), *.csv", MultiSelect:=True)
'キャンセル時の処理
If IsArray(filnames) = False Then Exit Sub
'ファイルの数だけ繰り返し
Application.ScreenUpdating = False
For Each myfile In filnames
　　'ファイル開く
　　Set mybook = Workbooks.Open(Filename:=myfile, ReadOnly:=True)
　　'ファイル名からシリアル値の作成
　　fname = Format(Left(mybook.Name, 12), "0000/00/00 00:00")
　　mySerial = DateValue(fname) + TimeValue(fname)
　　'値を取得・出力先へ書き出し
　　mybook.Activate
　　key = Year(mySerial) & Month(mySerial) & Day(mySerial) & Hour(mySerial)
　　For Each myRng In outbook.Columns("B").SpecialCells(xlCellTypeConstants, 23)
　　　　If IsDate(myRng) Then
　　　　　　If Year(myRng) & Month(myRng) & Day(myRng) & Hour(myRng) = key Then
　　　　　　　　myRng.Offset(0, 1).Value = ActiveSheet.Range("B6").Value
　　　　　　　　Exit For
　　　　　　End If
　　　　End If
　　Next myRng
　　'ファイル閉じる
　　Application.DisplayAlerts = False
　　Workbooks(mybook.Name).Close
　　Application.DisplayAlerts = True
　　'カウントアップ
　　cnt = cnt + 1
Next myfile
Application.ScreenUpdating = True
End Sub

お礼

Ctrlで複数選択したらできました。
ありがとうございました。とても助かります。
重ねて厚く御礼申し上げます。

また何かありましたらよろしくお願い申し上げます。

回答No.3

eden3616

補足確認しました。
補足の内容につきまして確認したい事柄があります。

(1)
>フォルダ内に

フォルダは一つのフォルダですね。仕様は現状通りファイルの選択方式とします。

(2)
>4/8 10時.csv , 4/8 11時.csv・・・・・・の様な感じで複数のファイルがあり、

CSVのファイル名ですが、半角の「/」はWindowsの制限により使用できないかと思いますが、
「○／△ □時.csv」というファイル名で統一されているものとします。（日時の間は半角スペース）
異なる場合は変則パターン（日時を取得できる方法が分かるパターンを提示ください）

(3)
>各.csvファイル毎に、B6の数値を取り出して。
>新しいExcelファイルC列に時系列毎にまとめて表示する。ような仕様が好ましいです。

各CSVファイルには数値が入っているようですが、「新しい」Excelファイルとのことですので
質問内容にあります「B列に日時が書いてある」は関係せず、とりあえず取得して一覧にするという事でしょうか。
また「時系列毎にまとめて」の解釈ですが、ただ複数CSVファイルの値の数（行数分）だけ時系順に書出すのか、
各日付の10時、11時の値を合計して時系列で表示するのかハッキリしませんでしたので、
現状は取得したものを書出すだけとしています（これでは出力結果はNo1と変わらないことになりますね）。

～～～～～～～～～～～～～～～～～～～～～～～～～～

C列に取得したシリアル値を入れて出力するようにしています。
(2)でご提示して頂いたファイル名以外のパターンが有ればエラーになるかと思います。
その場合は可能性のあるファイル名のパターンをご提示ください。
上記(3)により処理内容が大幅に変わってきますので、今回の実装とはせず
一度捕捉内容への確認という形を取らせていただきました。

■VBAコード

Sub 値取得()
'配列変数を宣言
Dim filnames As Variant
Dim myfile As Variant
Dim cnt As Long
Dim mybook As Workbook
Dim outbook As Worksheet
Dim fname As String
Dim myDate As Variant
Dim mySerial As Date
'出力先の先頭行番号
cnt = 1
'出力先のブックを格納
Set outbook = ActiveWorkbook.ActiveSheet
'ファイル名を配列変数に格納
filnames = Application.GetOpenFilename("CSVファイル (*.csv), *.csv", MultiSelect:=True)
'キャンセル時の処理
If IsArray(filnames) = False Then Exit Sub
'ファイルの数だけ繰り返し
For Each myfile In filnames
　　'ファイル開く
　　Set mybook = Workbooks.Open(Filename:=myfile, ReadOnly:=True)
　　'ファイル名からシリアル値の作成
　　fname = WorksheetFunction.Trim(StrConv(mybook.Name, vbNarrow))
　　fname = WorksheetFunction.Trim(StrConv(fname, vbNarrow))
　　myDate = Split(Replace(fname, ".csv", ""), " ")
　　mySerial = DateValue(myDate(0)) + TimeValue(myDate(1))
　　'値を取得・出力先へ書き出し
　　mybook.Activate
　　outbook.Cells(cnt, "B").Value = mySerial
　　outbook.Cells(cnt, "C").Value = ActiveSheet.Range("B6").Value
　　'ファイル閉じる
　　Application.DisplayAlerts = False
　　Workbooks(mybook.Name).Close
　　Application.DisplayAlerts = True
　　'カウントアップ
　　cnt = cnt + 1
Next myfile
'出力結果のソート
With outbook.Sort
　　.SortFields.Add Key:=outbook.Columns("B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
　　.SetRange Range("B:C")
　　.Header = xlGuess
　　.MatchCase = False
　　.Orientation = xlTopToBottom
　　.SortMethod = xlPinYin
　　.Apply
End With
End Sub

補足

回答ありがとうございます。再度追記致します。
・フォルダは１つのフォルダです。
・正確には、20150408100003.csvというファイル名です。
・合計はせずに、ただ複数CSVファイルの値の数（行数分）だけ時系順に書出す。

プランA(理想的)
・「"データ集.xlsx"のB列に日時が書いてある」ので
C列にB列の日時に合わせた数値を出力する。

プランB（Aが難しい場合の妥協案）
・新規ファイルにただとりあえず取得して一覧にする。

何卒よろしくお願い申し上げます。

回答No.2

eden3616

No1です。
初め取り出した値を配列に格納してから書き出そうとしたのですが、
ファイルを開きながら貼り付ける処理に変えたときの残骸が残っておりました。
VBAコード内の以下の2行は不要ですので削除願います。

'ファイルの最大数を取得して格納用配列を初期化
ReDim mydat(UBound(filnames))

また、異なる解釈をしている場合、要望があれば補足（・詳細説明）願います。

回答No.1

eden3616

デスクトップ上の出力先Excelシートの標準モジュールへ下記VBAコードを貼り付けてください。
出力先のシートを表示した状態でマクロ実行より「値取得」を実行すると、
ファイル選択のダイアログが表示されます。
対象のファイルを選択（複数可能）して開いてください。

現在アクティブになっているシートのC列1行目からファイル名順に値を取得して書出します。

>あるフォルダ内の複数の.csvファイル一つ一つから
>指定数値(B列6行目のみ)を取り出して、
>デスクトップ上、別のExcelシートの(B列１行毎に日付と時間が書いてある)

開いたCSVファイルの順番と、出力先のB列（日付：時間）の関係性が分からなかったため
読込み順に１行目から書き出す形としております。

出力開始行（初期は1行目）を変更する場合はコード内の「cnt=1」で変更ください。

■VBAコード

Sub 値取得()
'配列変数を宣言
Dim filnames As Variant
Dim myfile As Variant
Dim cnt As Long
Dim mybook As Workbook
Dim outbook As Worksheet
'出力先の先頭行番号
cnt = 1
'出力先のブックを格納
Set outbook = ActiveWorkbook.ActiveSheet
'ファイル名を配列変数に格納
filnames = Application.GetOpenFilename("すべてのファイル (*.*), *.*", MultiSelect:=True)
'キャンセル時の処理
If IsArray(filnames) = False Then Exit Sub
'ファイルの最大数を取得して格納用配列を初期化
ReDim mydat(UBound(filnames))
'ファイルの数だけ繰り返し
For Each myfile In filnames
　　'ファイル開く
　　Set mybook = Workbooks.Open(Filename:=myfile, ReadOnly:=True)
　　'値を取得・出力先へ書き出し
　　mybook.Activate
　　outbook.Cells(cnt, "C").Value = ActiveSheet.Range("B6").Value
　　'ファイル閉じる
　　Application.DisplayAlerts = False
　　Workbooks(mybook.Name).Close
　　Application.DisplayAlerts = True
　　'カウントアップ
　　cnt = cnt + 1
Next myfile
End Sub

補足

詳細な回答有難うございます。
私の説明不足でしたので、補足を申し上げます。

フォルダ内に
4/8 10時.csv , 4/8 11時.csv・・・・・・の様な感じで複数のファイルがあり、
各.csvファイル毎に、B6の数値を取り出して。
新しいExcelファイルC列に時系列毎にまとめて表示する。ような仕様が好ましいです。

何卒宜しくお願い申し上げます。