人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelのマクロに関する質問です。良い回答は、450ポイント差し上げます。
フォルダー内にあるエクセルのすべてのファイルから値を取得して、集計用ブックに貼り付ける。

※フォルダ内の【各都道府県ブック】には命名規則があり、各都道府県の名前がつけられています。
※フォルダ内に【集計ブック】の都道府県列の【都道府県ブック】が存在しない場合は、ログをテキストで出力したい。

【青森県ブック】(sheet1)
3 入金 出金 損害金
4 500 1000 300

【高知県ブック】(sheet1)
3 入金 出金 損害金
4 800 300 150

---集計後のイメージ---
【集計ブック】(Sheet1)
3 都道府県 入金 出金 損害金
4 青森県 500 1000 300
5 高知県 800 300 150
※都道府県列は、固定されています。

マクロでの回答は、ソースも記述願います。
どうか宜しくお願いします。

●質問者: anim130M
●カテゴリ:ビジネス・経営 コンピュータ
✍キーワード:Excel イメージ エクセル ソース テキスト
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● fonya3
●0ポイント

はっきり言って簡単に出来ますが、450ポイント(円)じゃ割が合わないので回答は難しいです。すいません。

でも、この(↓)へんとかを見て地道に勉強すれば出来ますよ。頑張ってください。

http://officetanaka.net/excel/vba/file/index.htm

◎質問者からの返答

回答ありがとうございます。

知識あるものに対価を払う。「はてな」を最大限に利用させていただいております。


2 ● きゃづみぃ
●450ポイント ベストアンサー

ログは集計ブックがあるところに エラーログ.txtとして出力されます。

存在しない都道府県名のみ出力されます。


Sub コピー作業()
'対象フォルダを指定してください。
'このフォルダに この集計用のブックは 入れないでください。
p = "C:\test\"

f = Dir(p & "*.xls", vbNormal)

Do While f <> ""
 Set w = Workbooks.Open(Filename:=p & f, UpdateLinks:=False, ReadOnly:=True)
 If Right(f, Len("ブック.xls")) = "ブック.xls" Then
 kenmei = Left(f, Len(f) - Len("ブック.xls"))
 Else
 kenmei = Left(f, Len(f) - Len(".xls"))
 End If
 
  '都道府県のブックの対象となるのは 4列目のみとする。
 b = w.Sheets("Sheet1").Cells(4, 1)
 
 For a = 4 To 65536
 If ThisWorkbook.Sheets("Sheet1").Cells(a, 1) = "" Then
  '見つからなかった場合は、ログ出力
 Open ThisWorkbook.Path & "\エラーログ.txt" For Append As #1
 Print #1, kenmei
 Close #1
 Exit For
 End If
 
 If kenmei = ThisWorkbook.Sheets("Sheet1").Cells(a, 1) Then
 
 ThisWorkbook.Sheets("Sheet1").Cells(a, 2) = w.Sheets("Sheet1").Cells(4, 1)
 ThisWorkbook.Sheets("Sheet1").Cells(a, 3) = w.Sheets("Sheet1").Cells(4, 2)
 ThisWorkbook.Sheets("Sheet1").Cells(a, 4) = w.Sheets("Sheet1").Cells(4, 3)
 
 Exit For
 End If

 Next a
 w.Close
 
 
 f = Dir
Loop

End Sub


◎質問者からの返答

回答ありがとうございました。

イメージ通りに動作しております。


3 ● Mook
●80ポイント

リストは固定、ということからフォルダを検索するのではなく、

集計ファイルにあるリストに対して該当するファイルを開いて集計する

処理にしました。

リスト上のファイルがない場合、ログに出力しています。


的外れでしたらポイント不要です。

Option Explicit

'// 集計対象フォルダ:以下の二つのファイルは集計フォルダ下に置きます。
'--------------------------------------------------------
Const 集計フォルダ = "C:\Data"

'// 集計ファイルは事前にあることを想定しています。
'--------------------------------------------------------
Const 集計ファイル名 = "【集計ブック】.xls"

'// ログファイルはない場合自動作成します。
'--------------------------------------------------------
Const ログファイル名 = "エラーログ.txt"

'---------------------------------
Sub 集計()
'---------------------------------
 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")
 
 Dim dstFilePath As String
 dstFilePath = 集計フォルダ & "\" & 集計ファイル名
 
'// 集計ファイルの確認
 If fso.FileExists(dstFilePath) = False Then
 MsgBox dstFilePath & "がありません。"
 Exit Sub
 End If
 
 Dim dstWB As Workbook
 Set dstWB = Workbooks.Open(dstFilePath)
 
 Dim dstWS As Worksheet
 Set dstWS = dstWB.Worksheets("Sheet1")
 
 Dim lastRow As Long
 lastRow = dstWS.Range("A" & Rows.Count).End(xlUp).Row
 
'// ログファイルを追記でオープン
 Dim logFilePath As String
 logFilePath = 集計フォルダ & "\" & ログファイル名
 
 Dim logFile As Object
 Set logFile = fso.OpenTextFile(logFilePath, 8, True)
 
 Dim srcFilePath As String
 Dim r As Long
 For r = 4 To lastRow
 srcFilePath = 集計フォルダ & "\【" & dstWS.Cells(r, "A").Value & "ブック】.xls"
 If fso.FileExists(srcFilePath) = True Then
'// データの転記
 With Workbooks.Open(srcFilePath)
 dstWS.Range("B" & r).Resize(1, 3).Interior.ColorIndex = 0
 dstWS.Range("B" & r).Resize(1, 3).Value = .Worksheets("Sheet1").Range("A4:C4").Value
 .Close
 End With
 Else
'// ログの出力
  '// ファイルがないセルを着色:不要な場合は次行を削除
 dstWS.Range("B" & r).Resize(1, 3).Interior.ColorIndex = 38
 logFile.WriteLine Application.Text(Now(), "YYYY-MM-DD HH:MM:SS") & ": " & srcFilePath & " がありません"
 End If
 Next
 
'// 終了処理
 logFile.Close
 
 dstWB.Save
 dstWB.Close
End Sub
◎質問者からの返答

回答ありがとうございました。

今回は、?回答者を採用させていただきました。


4 ● おかのこ
●0ポイント

皆さんの考えをまとめてみました。

http://officetanaka.net/excel/vba/file/index.htm

で地道に勉強する。


集計ファイルにあるリストに対して該当するファイルを開いて集計する

処理にする。

リスト上のファイルがない場合、ログに出力する

ログは集計ブックがあるところに エラーログ.txtとして出力される。

存在しない都道府県名のみ出力される。

こんなかんじです。450ポイントくれたら嬉しいです。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ