ExcelVBAについて質問です。

Question

japan-nan

31

31もっと見る

1000pt

コンピュータ

ExcelVBAについて質問です。

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

回答の条件

1人5回まで

登録：2012/08/29 02:34:25
終了：2012/08/29 18:00:50

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.2

きゃづみぃ1353911982012/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

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

2012/08/29 20:05:41

gong1971 2012/08/29 18:24:22

あ、質問終わっちゃいましたね。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

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

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

リクエスト送信済

回答リクエストを送信したユーザーはいません

cx20 · Accepted Answer · 2012-08-29T05:32:14+09:00

サンプルを書いてみました。
一応、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月」
実行結果

1	A	B	C	D	E	F	G	H	I	J	K	L
2	2012年6月	6001	6002	6003	6004	6005	6006	6007	6008	6009	6010	6011
3	2012年7月	7001	7002	7003	7004	7005	7006	7007	7008	7009	7010	7011
4	2012年8月	8001	8002	8003	8004	8005	8006	8007	8008	8009	8010	8011

cx20 · Accepted Answer · 2012-08-29T05:32:14+09:00

サンプルを書いてみました。
一応、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月」
実行結果

1	A	B	C	D	E	F	G	H	I	J	K	L
2	2012年6月	6001	6002	6003	6004	6005	6006	6007	6008	6009	6010	6011
3	2012年7月	7001	7002	7003	7004	7005	7006	7007	7008	7009	7010	7011
4	2012年8月	8001	8002	8003	8004	8005	8006	8007	8008	8009	8010	8011

ExcelVBAについて質問です。

ベストアンサー

cx206071082012/08/29 05:32:14

その他の回答（1件）

cx206071082012/08/29 05:32:14ここでベストアンサー

きゃづみぃ1353911982012/08/29 06:52:44

コメント（1件)

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