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

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

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

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

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

●質問者: yoshifuku
●カテゴリ:コンピュータ インターネット
✍キーワード:CSV Excel VBA いただきます イメージ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● Ktwo
●69ポイント ベストアンサー

下記の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
◎質問者からの返答

ありがとうございます!

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

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


2 ● たか
●1ポイント

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

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

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

◎質問者からの返答

ありがとうございます!

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

関連質問


●質問をもっと探す●



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