[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロ等で多数のファイルから特定セルを抽出したい』（EZ）
はじめまして。エクセルを勉強し始めたところで初心者ですのでお手柔らかにお願い致します。
今回、フォルダ内に多数のテンプレート化されたエクセルファイル（100程度）を集約する必要があり作業に追われています。マクロ等で解決できないかご相談です。
例）
Aフォルダ＞1.xlsx、2・・・・・
1.xlsx シート名 1、 A1,B2,C3,D4のセルとI列の最下セル（データを更新していくため、特定セルではありませんがI列の最も下のセル）
2.xlsx 同上
・・・
上記を一つのエクセルファイル
A B C D E F
1 1.xslx A1 B2 C3 D4 I●
2 2.xslx A1 B2 C3 D4 I●
3 ・・・
としたいのですが よい方法は無いでしょうか。
大変お忙しいとは思いますが何卒ご教示いただけると幸いです。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
シート名が共通、又は一定のルールに沿って与えられていれば閉じたまま処理できますが、 そうでなければ、一旦開いて閉じるということになるでしょうね。 いずれにしても、VBA処理です。 （seiya） 2019/03/08(金) 13:17
厚かましいお願いではありますが、何卒よろしくお願い致します。
（EZ） 2019/03/08(金) 18:17
であるなら、具体的に 各ファイル名とシート名の関連性をきちんと説明してください。
VBAはコードで命令したこと以外はやりません。 シート名が共通である場合はその名前、そうでなくても 各ファイルのファイル名とシート名に 関連性がある場合は具体的にその関連性。
上記の関連性が皆無の場合は、 各ファイルにどのくらいの枚数のシートがあって、 その中でどのような条件で 該当シートを探すのか。
等を詳しく説明してください。 （seiya） 2019/03/08(金) 18:34
ファイル名は各薬の名称が記載されているため一貫性はありません。
ファイル名とシート名にも関連はありません。
シート名は在庫管理１、在庫管理２、メンテナンス用の３つあります。
基本的には在庫管理１とメンテナンス用の２つですが、ファイルによっては在庫管理２がある場合があります
検索条件は
在庫管理１シートで
B1セル、B2セル、B3セル、E2セル、I列の最もしたのセル（行に上から順番に入･出庫の日付、払出、入庫数を記載していき、自動計算でIセルに最終現在個数が表示されるようになっています。そのため、特定のセルではなく、I列の最も下にある数字を拾いたいのです。）
（EZ） 2019/03/08(金) 19:31
おっと、返信に気が付きませんでした。
ということは、各ファイルの在庫管理１シートから該当データを抜き出す。 ということですか？
下記で試してください。
Sub test()
Dim myDir As String, fn As String, i As Long, n As Long, x, temp As String
Const wsName As String = "在庫管理１"
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダの選択"
If .Show Then myDir = .SelectedItems(1) & "\"
End With
If myDir = "" Then Exit Sub
Cells(1).CurrentRegion.Offset(1).ClearContents
fn = Dir(myDir & "*.xls")
n = 1
Do While fn <> ""
n = n + 1: temp = "'" & myDir & "[" & fn & "]" & wsName & "'!"
Cells(n, 1).Value = fn
For i = 1 To 3
Cells(n, i + 1).Value = ExecuteExcel4Macro(temp & "r" & i & "c" & i)
Next
x = ExecuteExcel4Macro("lookup(1,0/(" & temp & "r1c10:r10000c10<>""""),row(" & temp & "r1c10:r10000c10))")
If Not IsError(x) Then
Cells(n, 5).Value = ExecuteExcel4Macro(temp & "r" & x & "c10")
Else
Cells(n, 5) = CVErr(2042)
End If
fn = Dir
Loop
End Sub
（seiya） 2019/03/08(金) 21:51
お忙しい中ありがとうございます。
実際に動かしてみましたがREF#となるセルが多く、またI列のセルも０だったりと上手く動きませんでした。
言葉等で説明するのも伝わりづらい部分あるかと思い、テンプレートファイルを共有サイトにUpさせていただきましたのでご確認いただければ幸いです。
https://6.gigafile.nu/0316-c2676f12d369a573cd83e66183d06dadb
パスワード：1111
例：
B１セルの「テンプレート25mg」
B２セルの「１箱〇〇錠」
E2セルの「50」
B3セルの「aaaaaaaaaaa」
I19セルの「86」
を抽出したいと考えています
（EZ） 2019/03/09(土) 15:56
E2。B3は夫々空白です。 セルアドレスは間違いありませんか？
暫くPCから離れますので、とりあえずセルアドレスが正しいものと想定して
Sub test()
Dim myDir As String, fn As String, i As Long, n As Long, x, temp As String
Const wsName As String = "在庫管理１"
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダの選択"
If .Show Then myDir = .SelectedItems(1) & "\"
End With
If myDir = "" Then Exit Sub
Cells(1).CurrentRegion.Offset(1).ClearContents
fn = Dir(myDir & "*.xls")
n = 1
Do While fn <> ""
n = n + 1: temp = "'" & myDir & "[" & fn & "]" & wsName & "'!"
Cells(n, 1).Value = fn
Cells(n, 2).Value = ExecuteExcel4Macro(temp & "r1c2")
Cells(n, 3).Value = ExecuteExcel4Macro(temp & "r2c2")
Cells(n, 4).Value = ExecuteExcel4Macro(temp & "r2c5")
Cells(n, 5).Value = ExecuteExcel4Macro(temp & "r3c2")
x = ExecuteExcel4Macro("max(index((len(" & temp & _
"r1c9:r10000c9)>0)*row(" & temp & "r1c9:r10000c9),0))")
If Not IsError(x) Then
Cells(n, 6).Value = ExecuteExcel4Macro(temp & "r" & x & "c9")
Else
Cells(n, 6) = CVErr(2042)
End If
fn = Dir
Loop
End Sub
（seiya） 2019/03/09(土) 16:44
ありがとうございます。
一通りは出来ていたようなので、勉強しながら解析してきたいと思います。
ありがとうございました。
＊Iセルの一番下のセルとしていましたが、実際にはかなり下のセルに「ここまで」とあり目的の数字ではなく文字を拾ってきていました。ここを数字をひろってくるなどは可能なのでしょうか。
何から何まで質問で大変もうしわけありません。
EZ拝
（EZ） 2019/03/09(土) 17:52
> x = ExecuteExcel4Macro("max(index((len(" & temp & _
> "r1c9:r10000c9)>0)*row(" & temp & "r1c9:r10000c9),0))")
> If Not IsError(x) Then
> Cells(n, 6).Value = ExecuteExcel4Macro(temp & "r" & x & "c9")
> Else
> Cells(n, 6) = CVErr(2042)
> End If
を下記一行と差し替え
Cells(n, 6).Value = ExecuteExcel4Macro("lookup(10^10," & temp & "r1c9:r10000c9)")
（seiya） 2019/03/09(土) 18:50
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.