フォルダに入っているCSVファイルの条件に一致するデータの合計値をファイルごとに集計する方法

フォルダにCSVファイルが追加されていきます。
そのファイルをエクセルで開いて
フィルターを掛けて
条件をチェックして
当てはまるものの合計値を計算し
それを別のファイルに記入する
という作業をしています。

CSVファイルの列項目はすべて共通で、
行数はバラバラです
抽出条件は毎回同じです

この作業をなるべく自動化したいと思っています。
ファイル毎の合計値の一覧ができていればいいです。

アウトプットのイメージは下記のようなものです
ファイル名　合計値
ファイルA　201
ファイルB　40
ファイルC　1000

よろしくお願いいたします

質問者からの補足コメント

• ありがとうございます
  CSVファイルはキャンペーンの結果ファイルで
  中身は
  個人ID,個人の性年代コード，キャンペーンでの獲得ポイント，分類コード
  です。
  （ポイント以外は文字列）
  特定の分類コードの獲得ポイントの合計値（キャンペーンでの支払いポイントの合計値）を集計したいです

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/05/23 09:26

No.2 ベストアンサー 回答者： めぐみん_ 回答日時： 2020/05/23 11:26

No.1です。

取り敢えず新規Ｂｏｏｋにコードを記載しアクティブシートに結果が出るか確認してください。
CSVファイルが多い場合にはどこか別にフォルダを作成しコード内の

csv_Path = "D:\csv\" '◆ ＣＳＶを存在しているフォルダ名
keyword = "aaa" '◆ 検索値

この辺りを適宜修正して検証願います。

＞フィルターを掛けて
＞条件をチェックして

もし上記を人が確認するべき作業であればこのコードは無効になりますね。
CSVファイルをExcelで開いて中身を見られる状態にはしませんので。

Sub megu()
Dim objCn As Object
Dim objRS As Object
Dim strSQL As String
Dim csv_Path As String
Dim csv_Name As String
Dim keyword As String
Dim r As Range

Set objCn = CreateObject("ADODB.Connection")
Set objRS = CreateObject("ADODB.Recordset")
Set r = Range("A2") '◆ 書き込みスタート（アクティブセル）
Range("A1:B1").Value = Array("ファイル名", "合計値")

csv_Path = "D:\csv\" '◆ ＣＳＶを存在しているフォルダ名
keyword = "aaa" '◆ 検索値
csv_Name = Dir(csv_Path & "*.csv")

With objCn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Text;HDR=YES"
.Open csv_Path
End With

Do Until csv_Name = ""

strSQL = ""
strSQL = strSQL & " SELECT SUM([キャンペーンでの獲得ポイント])"
strSQL = strSQL & " FROM [" & csv_Name & "]"
strSQL = strSQL & " WHERE [分類コード] = '" & keyword & "' ;"

Set objRS = objCn.Execute(strSQL)

r.Value = Split(csv_Name, ".")(0)
r.Offset(, 1).CopyFromRecordset objRS
Set r = r.Offset(1)

objRS.Close

csv_Name = Dir()
Loop

objCn.Close
Set r = Nothing
Set objCn = Nothing
Set objRS = Nothing

End Sub

この回答へのお礼

足りない知識が多く、時間がかかってしまいました。申し訳ございません。
ご丁寧にご回答ありがとうございました。

お礼日時：2020/06/14 11:11

No.1 回答者： めぐみん_ 回答日時： 2020/05/23 08:12

個々のCSVファイルの中身がどのようになっているのかが不明なので今の情報では厳しいのでは？