今、Excelのファイル(複数シート有)が200個あり、

各ファイルに共通して存在するシート(シート名:Sheet2)の、
セル範囲「E6:DI23000」にある値を、
1つのcsvファイルとして集約させて出力させたいと思っています。
(単にシートの該当セルの結合のイメージです。そしてCSVファイル化。)

VBAで実現できると思いますが、
力及ばず、短時間での自力記述ができず、恥ずかしながら
質問させていただきます。

どうぞよろしくお願い致します。

※説明がわかりにくいようでしたらコメント欄にご質問ください。
※フリーソフトでもExcel⇒CSVにするものがありますが、
 複数ファイルかつ特定シートを一発で相手にできそうなものが
 見つかりませんでした。
※原本のExcelのファイルの内容には変更を与えないで実現したい
 です。

回答の条件
  • 1人1回まで
  • 登録:
  • 終了:2011/01/11 18:43:44
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:Ktwo No.1

回答回数22ベストアンサー獲得回数5

ポイント69pt

下記のVBAを貼り付けた、作業用のExcelシートに、以下の情報を設定して下さい。

A2:元ファイルのパス

B2(1000まで):元ファイルのファイル名一覧

C2:ターゲットのシート(Sheet2)

D2:ターゲットのセル範囲(E6:DI23000)

E2:出力先パス

F2:出力ファイル名

その後で、下記のVBAの『一括CSV出力』を実行して下さい。

(申し訳ありませんが、エラー処理などの調整は省略しています。)

Option Explicit

Dim TargetPath      As String
Dim TargetFile(999) As String
Dim TargetFile_CT   As Integer
Dim TargetSheet     As String
Dim TargetCell      As String
Dim OutputPath      As String
Dim OutputFileName  As String
Dim sWB             As String
Dim sSH             As String
Dim sBookName        As String
Dim sFileName        As String
Dim sTempFN          As String
Dim i               As Integer

Sub 一括CSV出力()
On Error GoTo 一括CSV出力_Error

    '情報取得
    TargetPath = Range("A2").Value
    For i = 0 To 999
        TargetFile(i) = Range("B" & i + 2).Value
        If TargetFile(i) = "" Then
            Exit For
        End If
    Next i
    TargetFile_CT = i - 1
    TargetSheet = Range("C2").Value
    TargetCell = Range("D2").Value
    OutputPath = Range("E2").Value
    OutputFileName = Range("F2").Value
    sTempFN = OutputPath & "\" & "_temp_.csv"
    
    For i = 0 To TargetFile_CT
    
        '一時処理用のブック作成
        Application.Workbooks.Add
        sWB = ActiveWorkbook.Name
        sSH = ActiveWorkbook.ActiveSheet.Name

        'ファイル一覧からファイル名を生成
        sBookName = TargetFile(i)
        sFileName = TargetPath & "\" & sBookName
        
        If 対象からコピー() = True Then
        
            Windows(sWB).Activate
            Sheets(sSH).Select
            
            'CSVファイル出力
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs _
                FileName:=sTempFN, _
                FileFormat:=xlCSV
            ActiveWindow.Close
            Application.DisplayAlerts = True
    
            'CSVファイルの結合
            Call CSVファイルの結合
    
        End If
        
    Next
    
    Exit Sub
    
一括CSV出力_Error:
End Sub

Function 対象からコピー() As Boolean
On Error GoTo 対象からコピー_Error

    対象からコピー = False
    
    'ファイルOPEN
    Workbooks.Open FileName:=sFileName, ReadOnly:=True
    
    'シート内容をコピー
    Sheets(TargetSheet).Select
    Range(TargetCell).Select
    Selection.Copy
    Windows(sWB).Activate
    Sheets(sSH).Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    'ファイルCLOSE
    Windows(sBookName).Activate
    ActiveWindow.Close
    
    対象からコピー = True
    
    Exit Function

対象からコピー_Error:
End Function

Sub CSVファイルの結合()
On Error GoTo CSVファイルの結合_Error

Dim sSource As String
Dim sDest   As String
Dim vWaitTime    As Variant

    If Dir(OutputPath & "\" & OutputFileName) <> "" Then
        sSource = OutputPath & "\" & OutputFileName & "+" & sTempFN
    Else
        sSource = sTempFN
    End If
    sDest = OutputPath & "\" & OutputFileName

    Shell "command.com /c COPY " & sSource & " " & sDest & " /B", vbHide

    vWaitTime = Now + TimeValue("0:00:01")
    Application.Wait vWaitTime
    
    Exit Sub
    
CSVファイルの結合_Error:
End Sub
id:miku1973

ありがとうございます!

内容理解に時間を頂きましたが、問題なく動作できました!

よくVBAの質問をするので、また機会がありましたらどうぞよろしくお願い致します。

2011/01/11 18:42:29

その他の回答1件)

id:Ktwo No.1

回答回数22ベストアンサー獲得回数5ここでベストアンサー

ポイント69pt

下記のVBAを貼り付けた、作業用のExcelシートに、以下の情報を設定して下さい。

A2:元ファイルのパス

B2(1000まで):元ファイルのファイル名一覧

C2:ターゲットのシート(Sheet2)

D2:ターゲットのセル範囲(E6:DI23000)

E2:出力先パス

F2:出力ファイル名

その後で、下記のVBAの『一括CSV出力』を実行して下さい。

(申し訳ありませんが、エラー処理などの調整は省略しています。)

Option Explicit

Dim TargetPath      As String
Dim TargetFile(999) As String
Dim TargetFile_CT   As Integer
Dim TargetSheet     As String
Dim TargetCell      As String
Dim OutputPath      As String
Dim OutputFileName  As String
Dim sWB             As String
Dim sSH             As String
Dim sBookName        As String
Dim sFileName        As String
Dim sTempFN          As String
Dim i               As Integer

Sub 一括CSV出力()
On Error GoTo 一括CSV出力_Error

    '情報取得
    TargetPath = Range("A2").Value
    For i = 0 To 999
        TargetFile(i) = Range("B" & i + 2).Value
        If TargetFile(i) = "" Then
            Exit For
        End If
    Next i
    TargetFile_CT = i - 1
    TargetSheet = Range("C2").Value
    TargetCell = Range("D2").Value
    OutputPath = Range("E2").Value
    OutputFileName = Range("F2").Value
    sTempFN = OutputPath & "\" & "_temp_.csv"
    
    For i = 0 To TargetFile_CT
    
        '一時処理用のブック作成
        Application.Workbooks.Add
        sWB = ActiveWorkbook.Name
        sSH = ActiveWorkbook.ActiveSheet.Name

        'ファイル一覧からファイル名を生成
        sBookName = TargetFile(i)
        sFileName = TargetPath & "\" & sBookName
        
        If 対象からコピー() = True Then
        
            Windows(sWB).Activate
            Sheets(sSH).Select
            
            'CSVファイル出力
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs _
                FileName:=sTempFN, _
                FileFormat:=xlCSV
            ActiveWindow.Close
            Application.DisplayAlerts = True
    
            'CSVファイルの結合
            Call CSVファイルの結合
    
        End If
        
    Next
    
    Exit Sub
    
一括CSV出力_Error:
End Sub

Function 対象からコピー() As Boolean
On Error GoTo 対象からコピー_Error

    対象からコピー = False
    
    'ファイルOPEN
    Workbooks.Open FileName:=sFileName, ReadOnly:=True
    
    'シート内容をコピー
    Sheets(TargetSheet).Select
    Range(TargetCell).Select
    Selection.Copy
    Windows(sWB).Activate
    Sheets(sSH).Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    'ファイルCLOSE
    Windows(sBookName).Activate
    ActiveWindow.Close
    
    対象からコピー = True
    
    Exit Function

対象からコピー_Error:
End Function

Sub CSVファイルの結合()
On Error GoTo CSVファイルの結合_Error

Dim sSource As String
Dim sDest   As String
Dim vWaitTime    As Variant

    If Dir(OutputPath & "\" & OutputFileName) <> "" Then
        sSource = OutputPath & "\" & OutputFileName & "+" & sTempFN
    Else
        sSource = sTempFN
    End If
    sDest = OutputPath & "\" & OutputFileName

    Shell "command.com /c COPY " & sSource & " " & sDest & " /B", vbHide

    vWaitTime = Now + TimeValue("0:00:01")
    Application.Wait vWaitTime
    
    Exit Sub
    
CSVファイルの結合_Error:
End Sub
id:miku1973

ありがとうございます!

内容理解に時間を頂きましたが、問題なく動作できました!

よくVBAの質問をするので、また機会がありましたらどうぞよろしくお願い致します。

2011/01/11 18:42:29
id:takashi_m17 No.2

回答回数120ベストアンサー獲得回数20

ポイント1pt

ファイル名一覧を準備しなくても良い方法

i = 2
sFileName = Dir(TargetPath & cnsDIR, vbNormal)
Do While sFileName <> ""
    i  = i + 1
    Cells(i,2).Value = sFileName
    sFileName = Dir()
Loop
i = 0
sFileName = ""

KtwoさんのA2に指定されたパス内にあるファイル一覧をB2からに返します。

    TargetPath = Range("A2").Value

 の後に入れたら良いかと思います。

id:miku1973

ありがとうございます!

やってみてはいないのですが、後日試してみたいと思います。

2011/01/11 18:42:58
  • id:Ktwo
    イルカ頂きまして、ありがとうございますm(__)m
    説明コメント少なくて、ゴメンナサイ^^;)

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

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

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

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