こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

別フォルダにあるエクセルファイルのF列値を、他ファイルにコピーさせたい

仕事で、ある機器の検証をしています。

検証テストをするときに使用するファイルが、「Aフォルダ」に140ファイルあります。(ファイル名「101_○○○.xls~240_○○○.xls」)

検証テストは、1ファイルずつ複数人で行います。

検証テストが終了したファイルは、Aフォルダから「B・C・Dフォルダ」のいずれかに切り取り移動されます。

ということで、移動されてしまったファイルは、Aフォルダ内を検索しても、#REF!と表示されてしまいます。

出来ていること
(1)ファイルの所在検索マクロの組立て
(2)Aフォルダ内にすべての140ファイルがあった場合のF列コピーマクロの組立て
※A,B,C,Dフォルダは、同フォルダ内、同階層にあります。
※すべてのフォルダは、会社のネットワークドライブ上にあります。
※Aフォルダ内のファイルは、最終的に0になります。
※各ファイルがA・B・C・Dフォルダのいずれに保存されているかは「ファイル所在検索マクロ」を実行しないと分かりません。

可能がどうか知りたいこと!!
ファイルの所在検索マクロから確認できたファイルの所在(ハイパーリンク付)&ファイル名から、ファイルを特定して、F列のコピーができるか?

「まとめのエクセルファイル」は、5シート構成です。
Sheet1…進捗&担当者一覧
Sheet2…101~240チェック_詳細結果
Sheet3…301~440チェック_詳細結果
Sheet4…501~640チェック_詳細結果
Sheet5…ファイル所在検索を求めるためのシート

上記の「Sheet2…101~240チェック_詳細結果」にマクロを入れたい。現状、このようになっています。

 A   B   C  D  E  F  G  H …列
ファイル名→→ 101 102 103 104 105 106 …
求めたい値  1  OK  OK NG OK  NG
↓ 2  NG OK NG OK OK
  ↓    3  OK OK NG OK OK
  ↓    4  OK OK NG NG OK
(行)
※列…ファイル名
※行…各ファイルのF8:F57に表示される値
※C列には、101_○○○.xlsのF8:F57の値をコピーしたいです。
 D列には、102_○○○.xlsのF8:F57の値をコピーしたいです。

質問がややこしいですが、ぜひお願いします!!

投稿日時 - 2008-04-30 00:38:23

QNo.3986394

すぐに回答ほしいです

質問者が選んだベストアンサー

下記の部分の意味が掴めないので、回答が付かないのだと思います。

>可能がどうか知りたいこと!!
>ファイルの所在検索マクロから確認できたファイルの所在
>(ハイパーリンク付)&ファイル名から、ファイルを特定して、
>F列のコピーができるか?

どの様に所在を確認されているか分かりませんが、例えば参考URLのコードを用いれば、見つかったファイルのフルパスが得られるので、そのファイルを開いてF列の値を引っ張ってくるのは容易だと思いますが、そういう事では無いのでしょうか?
多数のブックを開きたくないい場合は下記の回答No.2の様な方法もあります(取得はセル単位)が、過去との互換性のために残されているものですので、最新バージョンでも機能が残っているかどうかは知りません。
http://okwave.jp/qa2668111.html

参考URL:http://officetanaka.net/excel/vba/tips/tips36.htm

投稿日時 - 2008-04-30 22:28:11

補足

mitarashiさん、レスが遅くなり、すみません。
返信ありがとうございます!

まずは、ファイルの所在検索は↓
--------------------------------
Sub ファイル所在検索()
Dim vntF As Variant
Dim objFS As FileSearch
Dim objFSO As FileSystemObject
Dim dteDate As Date
Dim GYO As Long
Dim cntFound As Long

Set objFS = Application.FileSearch ' FileSearch
Set objFSO = New FileSystemObject ' FSO
Rows("5:65536").ClearContents
GYO = 4
With objFS
.NewSearch
.LookIn = Trim(Cells(1, 2).Value) ' Search開始フォルダ
.Filename = Trim(Cells(2, 2).Value) ' 探索ファイル式
dteDate = DateAdd("m", Cells(3, 2).Value * -1, Date)
.SearchSubFolders = True ' サブフォルダも探索
' 処理開始
If .Execute() <> 0 Then
' 見つかったファイル分のループ
For Each vntF In .FoundFiles
'--------------------------------
' ↓↓↓この間が見つかったファイルに対する処理↓↓↓
' FSOにてファイルを取得
With objFSO.GetFile(vntF)
' 今回は、最終更新日を確認し、該当ならシートの表示
If .DateLastModified >= dteDate Then
GYO = GYO + 1
Cells(GYO, 1).Value = _
Left(.Path, Len(.Path) - Len(.Name) - 1)
cntFound = cntFound + 1
Cells(GYO, 2).Value = .Name
Cells(GYO, 3).Value = .DateLastModified

End If
End With
' ↑↑↑この間が見つかったファイルに対する処理↑↑↑
'--------------------------------
Next vntF
End If
End With
Set objFS = Nothing
Set objFSO = Nothing
' 処理結果の表示
If cntFound = 0 Then
MsgBox "見つかりません"
Else
MsgBox cntFound & "個見つかりました"
End If
End Sub
----------------------------------
このようなコードを入れています。
mitarashiさんが貼り付けてくださっていた
参考URLのマクロと同じようなコードです。

もう一つのURLから、こちらを見つけました!
http://oshiete1.goo.ne.jp/qa2406030.html
参考になるコードがありましたので、明日試してみます!
ありがとうございます。

投稿日時 - 2008-05-01 20:32:27

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問