ExcelVBAについて質問です。

フォルダ内の複数のExcelファイル(報告〇〇.XLS)があり、各ファイルのセル値を取得して、
集計(集計.XLS)に転記したいと思います。
【取得条件】
・「報告〇〇.XLS」[チケット]シートの[E3]セル値を「集計.XLS」[集計]シートに転記
・「報告〇〇.XLS」[チケット]シートの[C9]~[M9]までのセル値を、上記で取得した値の横に羅列
・フォルダ選択時は選択ダイアログにしたい
【前提条件】
・Excel2003環境で使用
・フォルダ内のファイル数は80個くらいあります。
ソース付の回答を希望します。またよい回答は800ポイント以上差し上げます。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2012/08/29 02:34:25
  • 終了:2012/08/29 18:00:50

ベストアンサー

id:cx20 No.1

cx20回答回数606ベストアンサー獲得回数1072012/08/29 05:32:14

ポイント900pt

サンプルを書いてみました。
一応、Excel 2003 と Excel 2007 にて確認しています。

Option Explicit

' 集計表を作成する
Sub MakeSummarySheet()
    Dim strFileNames() As Variant
    Dim strFileName As Variant
    
    Dim nLine As Integer
    
    ' ファイルを開くダイアログを表示
    strFileNames = Application.GetOpenFilename( _
        FileFilter:="Excel ファイル (*.xls),*.xls", _
        MultiSelect:=True)

    nLine = 0
    If IsArray(strFileNames) Then
        ' 複数ファイル数ぶん処理する
        For Each strFileName In strFileNames
            nLine = nLine + 1
            ' 指定ファイルの情報を集計表に追記する
            Call AddSummarySheet(nLine, strFileName)
        Next
    Else
        MsgBox "キャンセルされました"
    End If
    
End Sub

' 指定ファイルの情報を集計表に追記する
Function AddSummarySheet(ByVal nLine As Integer, ByVal strFileName As String)
    Dim book As Workbook
    
    ' 集計対象ファイルをオープン
    Set book = Workbooks.Open(strFileName)
    
    ' 「チケット」シートの E3 を「集計」シートにに転記
    ThisWorkbook.Worksheets("集計").Cells(nLine, 1) = book.Worksheets("チケット").Cells(3, 5)
    
    Dim nColumn
    For nColumn = 1 To 11
        ' 「チケット」シートの C9~M9 を「集計」シートに転記
        ThisWorkbook.Worksheets("集計").Cells(nLine, 1 + nColumn) = book.Worksheets("チケット").Cells(9, 2 + nColumn)
    Next
    
    ' 集計対象ファイルをクローズ
    book.Close
    
End Function
  • テストデータ
    • ファイル1:[報告201206.xls] … E3のセル値「2012年6月」
    • ファイル2:[報告201207.xls] … E3のセル値「2012年7月」
    • ファイル3:[報告201208.xls] … E3のセル値「2012年8月」
  • 実行結果
1ABCDEFGHIJKL
22012年6月60016002600360046005600660076008600960106011
32012年7月70017002700370047005700670077008700970107011
42012年8月80018002800380048005800680078008800980108011
他1件のコメントを見る
id:japan-nan

回答いただきありがとうございます。
ダイアログ選択はファイル選択するようになってますが、
コードが入った「集計.xls」を選択するのでしょうか?

2012/08/29 17:45:23
id:cx20

「ファイル選択ダイアログ」は「集計.xls」でなく「報告〇〇.xls」を複数選択することを想定してました。
ご希望の動作と違っていたようで、失礼致しました。


「フォルダ選択ダイアログ」がご希望ということでしたら、コメント欄の id:gong1971 さんのサンプルが参考になるかと思います。

2012/08/30 02:15:36

その他の回答(1件)

id:cx20 No.1

cx20回答回数606ベストアンサー獲得回数1072012/08/29 05:32:14ここでベストアンサー

ポイント900pt

サンプルを書いてみました。
一応、Excel 2003 と Excel 2007 にて確認しています。

Option Explicit

' 集計表を作成する
Sub MakeSummarySheet()
    Dim strFileNames() As Variant
    Dim strFileName As Variant
    
    Dim nLine As Integer
    
    ' ファイルを開くダイアログを表示
    strFileNames = Application.GetOpenFilename( _
        FileFilter:="Excel ファイル (*.xls),*.xls", _
        MultiSelect:=True)

    nLine = 0
    If IsArray(strFileNames) Then
        ' 複数ファイル数ぶん処理する
        For Each strFileName In strFileNames
            nLine = nLine + 1
            ' 指定ファイルの情報を集計表に追記する
            Call AddSummarySheet(nLine, strFileName)
        Next
    Else
        MsgBox "キャンセルされました"
    End If
    
End Sub

' 指定ファイルの情報を集計表に追記する
Function AddSummarySheet(ByVal nLine As Integer, ByVal strFileName As String)
    Dim book As Workbook
    
    ' 集計対象ファイルをオープン
    Set book = Workbooks.Open(strFileName)
    
    ' 「チケット」シートの E3 を「集計」シートにに転記
    ThisWorkbook.Worksheets("集計").Cells(nLine, 1) = book.Worksheets("チケット").Cells(3, 5)
    
    Dim nColumn
    For nColumn = 1 To 11
        ' 「チケット」シートの C9~M9 を「集計」シートに転記
        ThisWorkbook.Worksheets("集計").Cells(nLine, 1 + nColumn) = book.Worksheets("チケット").Cells(9, 2 + nColumn)
    Next
    
    ' 集計対象ファイルをクローズ
    book.Close
    
End Function
  • テストデータ
    • ファイル1:[報告201206.xls] … E3のセル値「2012年6月」
    • ファイル2:[報告201207.xls] … E3のセル値「2012年7月」
    • ファイル3:[報告201208.xls] … E3のセル値「2012年8月」
  • 実行結果
1ABCDEFGHIJKL
22012年6月60016002600360046005600660076008600960106011
32012年7月70017002700370047005700670077008700970107011
42012年8月80018002800380048005800680078008800980108011
他1件のコメントを見る
id:japan-nan

回答いただきありがとうございます。
ダイアログ選択はファイル選択するようになってますが、
コードが入った「集計.xls」を選択するのでしょうか?

2012/08/29 17:45:23
id:cx20

「ファイル選択ダイアログ」は「集計.xls」でなく「報告〇〇.xls」を複数選択することを想定してました。
ご希望の動作と違っていたようで、失礼致しました。


「フォルダ選択ダイアログ」がご希望ということでしたら、コメント欄の id:gong1971 さんのサンプルが参考になるかと思います。

2012/08/30 02:15:36
id:taknt No.2

きゃづみぃ回答回数13539ベストアンサー獲得回数11982012/08/29 06:52:44

ポイント100pt

集計ファイルは
集計ファイル = "C:\test\集計.xls"
ここに パスを記述してください。


Sub main()

集計ファイル = "C:\test\集計.xls"


vntFileName = _
    Application.GetOpenFilename( _
         FileFilter:="エクセルファイル(*.xls),*.xls" _
       , FilterIndex:=1 _
       , Title:="ファイル選択(複数可)" _
       , MultiSelect:=True _
        )

   'ファイルが選択されているとき(vntFileNameが配列型)は
    '選択した全てのファイルをWorkbooks.Openメソッドを使い開きます。
    If IsArray(vntFileName) Then
        Set s = Workbooks.Open(集計ファイル)
        For Each vntGetFileName In vntFileName
            Set h = Workbooks.Open(vntGetFileName)
            k = 0
            If s.Sheets("集計").Cells(1, 1) = "" Then k = 1
            If k = 0 And s.Sheets("集計").Cells(2, 1) = "" Then k = 2
            If k = 0 Then
                k = s.Sheets("集計").Cells(1, 1).End(xlDown).Row + 1
            End If
            
            s.Sheets("集計").Cells(k, 1) = h.Sheets("チケット").Range("E3")
            For c = 1 To 11
                s.Sheets("集計").Cells(k, 1 + c) = h.Sheets("チケット").Cells(9, 2 + c)
            Next c
            
           h.Close
        Next
        s.Save
        s.Close
    
    End If


End Sub
id:taknt

あと 集計ファイルには 追記できるようにしてあります。

2012/08/29 20:05:41
  • id:gong1971
    あ、質問終わっちゃいましたね。orz
    お二方の回答の場合、ダイアログで処理するファイルを複数選択します。
    Shiftキーを使うと選択が簡単に出来ます。

    参考までに、作成しちゃったので私のコードを記載しておきます。
    フォルダを選択し、フォルダ内の「報告*.xls」ファイルを全て処理します。

    Sub Macro1()

    '# フォルダ選択ダイアログ表示
    Dim Shell
    Set Shell = CreateObject("Shell.Application")
    Set tmpPath = Shell.BrowseForFolder(0, _
    "フォルダを選択してください", &H1)

    '# 選択フォルダに移動
    If tmpPath Is Nothing Then Exit Sub
    ChDir tmpPath.Items.Item.Path

    '# フォルダ内のファイル("報告*.xls")を処理
    dd = Dir("報告*.xls")
    Do Until dd = ""
    Set tmpWB = Workbooks.Open(dd)

    '# 値のコピー
    With ThisWorkbook.Sheets("集計")
    lr = .Range("A1").SpecialCells(xlLastCell).Row + 1
    .Cells(lr, 1) = Cells(3, 5)
    .Range(.Cells(lr, 2), .Cells(lr, 12)).Value = _
    Range(Cells(9, 3), Cells(9, 13)).Value
    End With

    tmpWB.Close
    dd = Dir()
    Loop

    '# 最終行を選択
    Sheets("集計").Activate
    Cells(lr, 1).Select

    End Sub

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません