[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『原本ファイルへのデータの自動集積』(かまなん)
エクセルのマクロ?に関して質問です。
ほぼマクロに関しては初心者でございます。
エクセルでデータの集計を行っております。
各自同じ形式のファイルに記入してもらい、メールで送付して頂き、
その集めたデータを形式は同じ別ファイルのシートにデータを集積していく形で集めているのですが、
マクロ?を組んでボタン一つで集めることは可能でしょうか。
イメージとしては
送られてきたA’ファイルのデータの中で(4つのシートで項目別にしております)各シート新たに記入してある部分のみ取り出し、
(以前のデータは削除し、毎回同じA'ファイルに記入して頂いております)
原本であるAファイルにどんどん追加していくイメージです。
ファイル名:共有原本(蓄積するファイル)
ファイル名:記入表(記入していただくファイル)
シート名ですが、共有原本、記入表ともに
シート1:作業1
シート2:作業2
シート3:作業3
シート4:作業4
セルの範囲ですが
共有原本に関して
作業1:B6からH6の7つのセル
作業2:B23からD23の3つのセル
作業3:B11からH11の7つのセル
作業4:B10からF10の5つのセル
以上の列から始まり、どんどん追加していく様にしていのです。
記入表ファイルでは作業1〜4まで共通して
行は固定ですが、毎回どの列まで記入されるかはわかりません。
記入された所までを判別し、共有原本のファイルに追加していくことは可能でしょうか。
共有原本の列に関してはデータがある限り追加していきたいと考えておりますので上限を考えておりません。
仮に上限が必要でしたら1000で設定お願いできますでしょうか。
解り難い文章で大変申し訳ございませんが宜しくお願い申し上げます
< 使用 Excel:Excel2007、使用 OS:WindowsVista >
ファイルというのはメールに添付された状態を想定しているのでしょうか。 それとも、あるフォルダに保存した後、もしくは EXCEL で開いた状態での処理を 想定しているでしょうか。
前者であれば、ちょっと(?)敷居は高くなります。 その際も VBA で処理するのであれば使用しているメールソフトが Outlook で あるほうが楽ですがそのあたりはどうでなのでしょうか。 (Mook) 2014/04/10(木) 19:25
共有原本と同じフォルダにあることを想定しております。
(かまなん) 2014/04/11(金) 03:29
ではとりあえず、フォルダ内のファイル処理前提で。 こんな感じのことでしょうか。
'// 要設定:ツール ⇒ 参照設定 ⇒ 「Microsoft Scripting Runtime」 にチェック
Public fso As New Scripting.FileSystemObject
'----------------------------------------------------------------------- Sub データ追加() '----------------------------------------------------------------------- For Each ファイル In fso.GetFolder(ThisWorkbook.Path).Files If InStr(UCase(fso.GetExtensionName(ファイル.Path)), "XLS") > 0 And InStr(ファイル.Name, "~$") = 0 Then If ファイル.Name <> ThisWorkbook.Name Then ファイルデータ追加 ファイル.Path End If End If Next End Sub
'----------------------------------------------------------------------- Sub ファイルデータ追加(ファイルパス) '----------------------------------------------------------------------- Dim コピー元WS As Worksheet With Workbooks.Open(ファイルパス) For Each コピー元WS In .Worksheets Select Case コピー元WS.Name Case "作業1": シートデータ追加 コピー元WS, 6, "H" Case "作業2": シートデータ追加 コピー元WS, 23, "D" Case "作業3": シートデータ追加 コピー元WS, 11, "H" Case "作業4": シートデータ追加 コピー元WS, 10, "F" End Select Next .Close False End With End Sub
'----------------------------------------------------------------------- Sub シートデータ追加(コピー元WS As Worksheet, 開始行 As Long, 最終列 As String) '----------------------------------------------------------------------- Const 開始列 = "B"
Dim コピー先WS As Worksheet Set コピー先WS = ThisWorkbook.Worksheets(コピー元WS.Name)
Dim コピー先最終行 As Long コピー先最終行 = コピー先WS.Cells(Rows.Count, 開始列).End(xlUp).Row + 1 If 開始行 > コピー先最終行 Then コピー先最終行 = 開始行
Dim コピー元最終行 As Long コピー元最終行 = コピー元WS.Cells(Rows.Count, 開始列).End(xlUp).Row
If コピー元最終行 < 開始行 Then Exit Sub
Dim コピー範囲 As Range Set コピー範囲 = コピー元WS.Range(コピー元WS.Cells(開始行, 開始列), コピー元WS.Cells(コピー元最終行, 最終列))
コピー範囲.Copy コピー先WS.Cells(コピー先最終行, 開始列).Resize(コピー範囲.Rows.Count, コピー範囲.Columns.Count) End Sub
(Mook) 2014/04/11(金) 12:38
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.