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

フォルダの中にあるexcelファイルを再帰的に処理したい

フォルダの中にExcelのファイルが複数あり、さらにそのフォルダの中にフォルダがありexcelファイルが存在するとします。全てのExcelファイルのA1からA10まで数値が入っているとします。その数値を足した値を新規のexcelファイルをデスクトップに作りA1から順にデータを書き込んでいきたいとします。

例えばX,Y,ZファイルがXYZフォルダにはいっています。XYZフォルダにはXXフォルダも入っていて、フォルダの中にはXX,YY,ZZファイルがあります。各ファイルのA1からA10までの合計はX=10,Y=20,Z=30,XX=15,YY=25,ZZ=35となったとします。デスクトップに新規Excelファイルを作りA列にファイル名、B列に合計に表示したいという場合、どのような技術を使って、どのような関数を使って、どのような処理順で処理すればいいのでしょうか?VBでアプリケーションを作ればそのような処理はできるかと思いますが、どのような関数を使って、どのような処理順で処理していったらいいか教えてください。

●質問者: popattack
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:A1 A10 Excel VB XYZ
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● きゃづみぃ
●0ポイント

http://www.excel-jiten.net/formula/ref_other_books.html

エクセルでほかのブックを参照するには

='パス名[ブック名]シート名'!セル名

とします。

これで セルに入れていけばいいでしょう。

◎質問者からの返答

これだと1000フォルダに5000ファイルあったときに無理があります。そういうことをしたくないのでアイディアを聞いているんです。


2 ● Mook
●50ポイント

一応今回の内容を実現する VBA(マクロ)の例です。

下記のコードを標準モジュールに入れたファイルを作成し、マクロの実行から mySum を実行してみてください。

Option Explicit

Public dataLine As Long

'-------------------------------------------
Sub mySum()
'-------------------------------------------
 Dim MyFolder As String
 
'--- フォルダを選択
 With Application.FileDialog(msoFileDialogFolderPicker)
 If .Show = -1 Then 'アクションボタンがクリックされた
 MyFolder = .SelectedItems(1)
 Else 'キャンセルボタンがクリックされた
 MyFolder = "CANCEL"
 End If
 End With
 
 With ThisWorkbook
 .Worksheets.Add before:=.Worksheets(1)
 End With
 
 dataLine = 1
 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")
 checkFolder fso, MyFolder


'--- 新規ファイルとして保存
 Dim dstFile As String
 dstFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\集計結果.xls"
 
 With ThisWorkbook
 .Worksheets(1).Copy
 ActiveWorkbook.SaveAs dstFile
 Workbooks("集計結果.xls").Close
 Application.DisplayAlerts = False
 .Worksheets(1).Delete
 Application.DisplayAlerts = True
 End With
 
End Sub

'-------------------------------------------
Sub checkFolder(fso As Object, filePath As String)
'-------------------------------------------
'--- フォルダ下のファイルを検索して集計
 Dim f As Object
 Dim d As Object
 
 For Each f In fso.getFolder(filePath).Files
 If UCase(fso.GetExtensionName(f.Path)) = "XLS" Then
 sumOneFile f.Path
 End If
 Next
 
 For Each d In fso.getFolder(filePath).SubFolders
 checkFolder fso, d.Path
 Next
End Sub

'-------------------------------------------
Sub sumOneFile(filePath As String)
'-------------------------------------------
'--- ファイルのデータを集計
 With Workbooks.Open(filePath)
 ThisWorkbook.Worksheets(1).Cells(dataLine, "A").Value = filePath
 ThisWorkbook.Worksheets(1).Cells(dataLine, "B").Value _
 = Application.WorksheetFunction.Sum(.Worksheets(1).Range("A1:A10"))
 .Close
 End With
 dataLine = dataLine + 1
End Sub

http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_040.html

不明な点はコメントにて対応しますので、コメントを有効にお願いします。

◎質問者からの返答

コードまで書いて頂いてありがとうございます!試してみます!


3 ● degucho
●0ポイント

VBのバージョン表記がありませんが、6.0だと仮定すると

・Dir関数またはFileSystemObjectでフォルダツリーを再帰的に走査

・OLE操作でworksheet.Range.valueを取得して計算

・OLE操作で新規ブック作成

が定石かと思います


いずれも「VB フォルダ 再帰」「VB Excel」などでネット検索すると

サンプルが沢山出てきますので頑張ってください

http://hanatyan.sakura.ne.jp/


4 ● ardarim
●50ポイント ベストアンサー

サンプルです。

COMオブジェクトを使わずExcelのネイティブ機能で攻めてみました。

Option Explicit
Option Base 1

Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _
 (ByVal hwndOwner As Long, ByVal lpszPath As String, ByVal nFolder As Long, ByVal fCreate As Long) As Long

' 起点となるフォルダ名
Const rootFolder As String = "c:\temp\"

Sub MakeSum()

 Dim summaryFileName As String
 Dim summaryBook As Workbook
 Dim summarySheet As Worksheet
 Dim szDesktopPath As String
 
 Application.ScreenUpdating = False
 
 Set summaryBook = Workbooks.Add
 Set summarySheet = summaryBook.Worksheets(1)
 
 Call RecursiveSum(summarySheet, 1, rootFolder)
 With summarySheet
 .Range(.Columns(1), .Columns(2)).AutoFit
 End With

 ' デスクトップフォルダの取得
 szDesktopPath = String$(260, " ")
 If SHGetSpecialFolderPath(0, szDesktopPath, 0, 0) <> 0 Then
 szDesktopPath = Left$(szDesktopPath, InStr(szDesktopPath, vbNullChar) - 1) & "\"
 Else
 szDesktopPath = rootFolder
 End If

 ' 保存
 summaryFileName = szDesktopPath & "summary.xls"
 If Dir(summaryFileName) <> "" Then
 If MsgBox(summaryFileName & "は既に存在します。上書きしますか?", vbYesNo) = vbNo Then
 summaryBook.Close False
 Exit Sub
 End If
 Kill summaryFileName
 End If
 summaryBook.SaveAs summaryFileName
 summaryBook.Close False

 Application.ScreenUpdating = True

End Sub

' フォルダ内のXLSファイルの処理とサブフォルダの再帰呼出し
Function RecursiveSum(ByRef summarySheet As Worksheet, ByVal r As Long, ByVal baseFolder As String) As Long

 Dim i As Long, m As Long
 Dim n As Long
 Dim xlsFilePath As String
 Dim subFolders() As String
 
 n = 0

 ' フォルダ内のXLSファイルをリストアップ
 xlsFilePath = Dir(baseFolder & "*.xls", vbNormal)
 Do While xlsFilePath <> "" And xlsFilePath <> ThisWorkbook.Name
 summarySheet.Cells(r + n, 1).Value = baseFolder & xlsFilePath
 summarySheet.Cells(r + n, 2).Value = GetSum(baseFolder & xlsFilePath)
 n = n + 1
 xlsFilePath = Dir()
 Loop
 
 ' フォルダ内のサブフォルダをリストアップ
 m = 0
 xlsFilePath = Dir(baseFolder, vbDirectory)
 Do While xlsFilePath <> ""
 If Left$(xlsFilePath, 1) <> "." Then
 If GetAttr(baseFolder & xlsFilePath) And vbDirectory Then
 m = m + 1
 ReDim Preserve subFolders(m)
 subFolders(m) = baseFolder & xlsFilePath & "\"
 End If
 End If
 xlsFilePath = Dir()
 Loop
 
 ' 各サブフォルダを再帰的に呼出し
 For i = 1 To m
 n = n + RecursiveSum(summarySheet, r + n, subFolders(i))
 Next i
 
 ' 処理したファイル数を返す
 RecursiveSum = n

End Function

' ファイルを開いてA1:A10の合計を得る
Function GetSum(ByVal xlsFilePath As String) As Variant

 With Workbooks.Open(xlsFilePath, 0, True)
 GetSum = WorksheetFunction.Sum(.Worksheets(1).Range("A1:A10"))
 .Close False
 End With

End Function

URLはダミーです。

http://q.hatena.ne.jp/1196326344

◎質問者からの返答

コードまで書いて頂いてありがとうございます!試してみます!

関連質問


●質問をもっと探す●



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