[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数エクセルファイルの複数シートからセル内容を1つの表に抽出するマクロ』（saya）
別で質問をしたのですがコメントがなく非常に困っていますので新たに質問させてください。
フォルダの中にある複数ファイルから必要なファイルを選択し特定セルの内容を1つの表に抽出 したい。
前提として、 ・フォルダの中には関係のないファイルも入っているが抽出対象としたいのはその中の数ファイルのみ ・抽出対象としたい複数ファイル名はばらばら ・抽出対象のファイルのフォーマットはシート名毎に異なる（フォーマット毎にシート名は同じ） ・フォーマット毎（シート名毎）の抽出したいセル番号（複数）は同じ ・抽出先のリストファイルにはファイル名、シート名を表示させたい ・抽出先のリストファイルには｢値で貼り付け｣でデータを貼り付けたい
現在はこんなファイル構成になっています あ.xls ｢東京｣sheet い.xls ｢神奈川｣sheet う.xls ｢千葉｣sheet え.xls ｢東京｣sheet お.xls ｢東京｣sheet か.xls ｢神奈川｣sheet ※シート名が同じものはフォーマットも同じ
これらの要件を満たすため、 ・対象ファイルはフォルダ指定ではなく複数ファイルを選択するようにしたい ・ファイルフォーマットによりシート名が数種類出現し、シート名が変わった時も対応できるようにシート名（複数）を指定できるようにしたい
これらのファイルには共通項目が含まれており、あ.xls～か.xlsの共通項目の入力内容を照合しないといけないのです。 現在この処理件数が数千件あり、1件ずつ（1フォルダずつ）必要なファイルから紙出力してチェックしています。 果てしないこの作業をある程度データで処理したいのです。
どうかよろしくお願いいたします。
WindowsVista, Excel2003
（saya）
- - - -
直接の回答じゃないんで、恐縮ですが、
現在の雑然とした状況のままやっつけ仕事のマクロを作っちゃうよりも、
全てのシートのデータを系統立てて一覧表（リスト・データベース）に
構築しなおしてしまったほうが良くないですか？
ひとつのシート内でデータの比較作業したほうが速いような気がしますけど。
（みやほりん）
みやほりんさん
ごめんなさい、どういう事なのか理解できません。 どういう処理なのでしょうか？
解決方法は何でも構いませんのでアドヴァイスをお願いします。
saya
前回は、一つのブックに付き 確認セルが複数シートに分かれてありましたが 今回は一つのシートにまとまっているのですか？
また、対象シートは一つのブックに一つしかないのでしょうか？
(HANA)
HANAさん
前回というのは何を指していますか？ 読み取れなくてすみません。
対象シートは1つのブックに1つしかありません。
saya
HANA さん
前回というのは私の前回の質問ですね。失礼しました。
今回も確認セルは複数シートに分かれています。 (今の所1つのシートなのですが複数シートを想定しておいた方がいいと思いました) そうすると対象シートは1つのブックに複数ということになってしまいます。 すみません。。
また対象シート(指定シート)がない場合もあるかもしれません。 その場合エラーで止まらず見つけたシート分抽出データを吐き出したいです。
前回のマクロを私の方で修正しようとしましたがやはり分からず今回新たに質問した次第です。
どうか助けてください。
saya
> フォルダの中にある複数ファイルから必要なファイルを選択し特定セルの内容を1つの表に抽出 > したい。
1) どのフォルダの 2) 何というファイル名の 3) どの範囲を 4) 何処へ
抽出したいの？ (seiya)
たぶんここで回答されている方なら、誰でも簡単に回答できるレベルの質問ですね。
とりあえずこんな感じと回答すると、たぶん、次から次へ、また、質問が出るのでしょうね。
どう考えても、丸々いちから作ってくださいという、質問ですよね。
私の考えはそれはそれで構わないと思いますが。
あるいは質問の仕方を変えて、
１．あるフォルダにあるファイルを開くには？
として、これが解決したら、
２．シート名を取得するには？
と、別々に質問して、最後にまとめるという方法もありますが。
（ご凡）
＞今回も確認セルは複数シートに分かれています。 ＞(今の所1つのシートなのですが複数シートを想定しておいた方がいいと思いました) ＞そうすると対象シートは1つのブックに複数ということになってしまいます。
前回の質問時は、seiyaさんのご質問内にある ＞＞3) どの範囲を の部分に関して
＞＞新規ファイルのB列以降に、1行目にシート名､2行目に取得したい位置を記載して､ ＞＞ A B C D ＞＞1 Sheet1 Sheet1 Sheet3 ＞＞2 ファイル名 A5 B10 C1 ＞＞3
の様にしましたよね？
今回もその様に 一行の中に ●●シートからのデータと ××シートからのデータがある ●●シートはあるが、××シートが無いこともある と言った感じなのか、それとも条件は↓の様に与えて A B C D 1 シート名 2 東京 A5 B10 C1 3 神奈川 A6 C11 B1 で、ブックによって 東京シートがなかったり 神奈川シートが無かったりする と言う事なのか。。。？
なお、seiayさんが参戦して下さっているので ＞＞1) どのフォルダの ＞＞2) 何というファイル名の おそらく、実行の都度 フォルダを開いてファイルを選択するつもりかとは思いますが ファイル名やフォルダに関して何か法則があるなら それもご説明されておかれると良いかもしれません。
(HANA)
＞ ごめんなさい、どういう事なのか理解できません。
1000以上のブックやシートを相手に仕事をするのは大変です。
そういう状況から脱出したくなったら声をかけてください。
たぶん、ブックの数は100分の1以下でも運用できます。
（ただし、すぐに結果は出ないし、途中は楽じゃないし、
考え方そのものを変える覚悟で）
(みやほりん)(-_∂)b
皆さん、私の質問が紛らわしくご迷惑をおかけしてすみません。
(saya)
HANAさん
＞＞新規ファイルのB列以降に、1行目にシート名､2行目に取得したい位置を記載して､ ＞＞ A B C D ＞＞1 Sheet1 Sheet1 Sheet3 ＞＞2 ファイル名 A5 B10 C1 ＞＞3
＞の様にしましたよね？
＞今回もその様に ＞一行の中に ●●シートからのデータと ××シートからのデータがある ＞●●シートはあるが、××シートが無いこともある ＞と言った感じなのか
HANAさんのお聞きの通りです。
また、実行の都度フォルダを開いてファイルを選択するつもりです。 理由は1つのフォルダの中には関係のないエクセルファイルやPDFファイルも入っているからです。 ファイル名やフォルダに関しても残念ながら法則がありませんので、私なりに考えて選択するしかないのかなと思いました。 (saya)
もしも「どのようにでも出力できるよ」となったとき 出力結果がどのようになっているのが良いのか 書いてみて下さい。
前回のスレの様に、 ○○シートの△セルは○列目に配置 して、 ○○シートが無かった場合そのセルは空白にしておく のが良いのか？ 値を見ればどのシートのどのセル由来かわかるので 前詰めで表示されればよい のか。。。
あるいは ○○シートと××シートは同じ作りになっているので 同じブックに有っても行を分けて表示し 先頭列に、何シート由来なのかシート名を書く 等。
こちらでは、どのようなデータを扱っていて チェックをするために、どの様になっていれば良いのかわかりません。
そちらの希望を書いてもらうと良いと思います。
その他 次の実行をした時 以前集めたデータを、出力結果の位置にそのまま残しておくのか それとも、チェックが済んだ後に再実行するから 古いデータは消して良いのか。
セルの情報以外は、どのような情報があるのが良いのか。 前回は、A列にファイル名だけでしたよね？
決めないといけない事はたくさんありますので それも書いておいてもらうと良いかもしれません。
(HANA)
前回のような質問の仕方で書いた方がいいでしょうか。
現在 Book1.xls Sheet1：A5, B10／Sheet3：C1 Book2.xls Sheet2：A1, D6 Book3.xls Sheet1：A5, B10／Sheet3：C1 ・ ・
新規ファイルのC列以降に、1行目にシート名、2行目に取得したい位置を記載して、
A B C D E F G
1 Sheet1 Sheet1 Sheet2 Sheet2 Sheet3
2 A5 B10 A1 D6 C1
3
4 Book1 Sheet1 A5 B10 空白 空白 空白
5 Book1 Sheet3 空白 空白 空白 空白 C1
6 Book2 Sheet2 空白 空白 A1 D6 空白
7 Book3 Sheet1 A5 B10 空白 空白 空白
8 Book3 Sheet3 空白 空白 空白 空白 C1
※4行目以降に取得したデータを表示させたい ※3行目は空行←取得するセル内容の項目名を私の方で入力したい ※次の実行をした時、累積となるように、以前集めたデータを出力結果の位置にそのまま残しておきたいです。可能ですか？ ※情報としては、A列にファイル名、B列に由来シート名を入れたい
現在Book1,2,3の作業対象ファイルは物件毎(例えば世田谷フォルダ、練馬フォルダ)に1つのフォルダに格納されています。
世田谷フォルダ Book1計算書.xls 確認書Book2.xls Book3.xls 関係ないファイル1.xls 関係ないファイル2.pdf
練馬フォルダ Book1計算.xls Book2確認書.xls Book3.xls 関係ないファイル1.xls 関係ないファイル2.pdf
フォルダ指定だと関係ないファイルまで拾ってしまう為、フォルダ単位で作業をし、複数ファイルをいちいち選択するしかないと思いました。 また対象ファイル名には例えば"計算書"や"確認書"などのファイルフォーマット毎のキーワードが含まれてはいるものの規則性がありません。 （ファイル名に規則性があるのなら、作業用に一旦バッチで対象ファイルを抜き出してもいいと思ったのですが、残念ながらファイル名がまちまちで・・）
上記のリストが出来れば、あとは次の段階で各シートに出現する共通項目（例えば、氏名、住所、管理番号など）を照合できるように、 次のシートに、1シート目の上記リストから項目を揃えるために関数で拾うつもりです。
質問される度に内容が少しずつ変わってしまい申し訳ありません。システマチックにすっきり考えられない私ですので、まどろっこしい事を言っているかも知れません。 本当に申し訳ありません。。
（saya）
とりあえず、A3,B3セルには見出しを入れてもらって良いですか？
↓コードです。
'------
Sub saya1()
Dim dic As Object, dicT As Variant
Dim myS As Variant
Dim i As Long, mxc As Long
Dim myR As Long, myC As Long
Dim tws As Worksheet
Dim wba As Variant, myB As Variant
Set tws = ActiveSheet
Set dic = CreateObject("Scripting.Dictionary")
mxc = Cells(1, Columns.Count).End(xlToLeft).Column
myR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To mxc
If dic.exists(Cells(1, i).Value) Then
dic(Cells(1, i).Value) = dic(Cells(1, i).Value) & "," & Cells(2, i).Value
Else
dic(Cells(1, i).Value) = i & "," & Cells(2, i).Value
End If
Next
wba = Application.GetOpenFilename( _
FileFilter:="エクセルファイル(*.xls),*.xls" _
, MultiSelect:=True)
If IsArray(wba) Then
For Each myB In wba
With Workbooks.Open(myB)
For Each myS In .Worksheets
If dic.exists(myS.Name) Then
myR = myR + 1
dicT = Split(dic(myS.Name), ",")
myC = dicT(0)
tws.Cells(myR, 1).Value = Dir(myB)
tws.Cells(myR, 2).Value = myS.Name
For i = 1 To UBound(dicT, 1)
tws.Cells(myR, myC).Value = myS.Range(dicT(i)).Value
myC = myC + 1
Next
End If
Next
.Close False
End With
Next
End If
Set dic = Nothing
Set tws = Nothing
End Sub
'------
ご説明の様なリストになると思います。
A3,B3が空白のままにしておきたいなら、もう少しコードを変更しますが。
(HANA)
HANAさん
ありがとうございます。 今仕事で外出先からなので戻ったらやってみます。
上記はA3、B3の見出しが入っている（ブランクでない）前提でのコードなのでしょうか？
（saya）
＞上記はA3、B3の見出しが入っている（ブランクでない）前提でのコードなのでしょうか？ です。
A列に入力がある最後の行の次の行から書き出します。 見出しでなくても良いですが、何か入力しておいてください。 B3セルはブランクでも関係ないです。
空欄のままにしておきたければ
myR = Cells(Rows.Count, 1).End(xlUp).Row
の行を
myR = Application.Max(Cells(Rows.Count, 1).End(xlUp).Row, 3)
にして下さい。
(HANA)
Fileを開かない方法
Sub test()
Dim fn, e, a, i As Long, ii As Long, LastR As Range
Dim s, v, x, myFile, myPath, temp, n As Long
With Sheets("Sheet1")
a = Range("a1", .Cells.SpecialCells(11)).Resize(2).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 1 To UBound(a, 2)
If a(1, i) <> "" Then
If Not .exists(a(1, i)) Then
Set .Item(a(1, i)) = _
CreateObject("Scripting.Dictionary")
.Item(a(1, i)).CompareMode = 1
End If
.Item(a(1, i))(a(2, i)) = VBA.Array(Range(a(2, i)) _
.Address(ReferenceStyle:=xlR1C1), i)
End If
Next
fn = Application.GetOpenFilename(MultiSelect:=True)
If IsArray(fn) Then
ReDim a(1 To (UBound(fn) + 1) * .Count, 1 To UBound(a, 2))
For Each e In fn
x = InStrRev(e, "\")
myFile = Mid$(e, x + 1)
myPath = Left$(e, x)
For Each s In .keys
n = n + 1
a(n, 1) = myFile: a(n, 2) = s
For Each v In .Item(s)
temp = myPath & "[" & myFile & "]" & s & "'!" & .Item(s)(v)(0)
If ExecuteExcel4Macro("isref('" & temp & ")") Then
a(n, .Item(s)(v)(1)) = "='" & temp
End If
Next
Next
Next
End If
End With
Set LastR = .Range("a4")
If Not IsEmpty(LastR) Then Set LastR = .Range("a" & Rows.Count).End(xlUp)(2)
With LastR.Resize(n, UBound(a, 2))
.Value = a
'.Value = .Value '<--- 値に変換する場合は ' を削除
End With
End With
End Sub
(seiya)
HANAさん、seiyaさん
目的のものができました！ 本当にありがとうございます。 これで数千件の処理がかなり楽になります。 これをベースに処理マクロ追加します。
ありがとうございました。
(saya)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.