Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5614 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【49625】フォルダ配下のファイルからデータを転記したいのですが・・・ momo 07/6/13(水) 21:26 質問[未読]
【49626】Re:フォルダ配下のファイルからデータを転... ウッシ 07/6/13(水) 23:14 発言[未読]
【49655】Re:フォルダ配下のファイルからデータを転... momo 07/6/14(木) 21:20 発言[未読]
【49657】Re:フォルダ配下のファイルからデータを転... ウッシ 07/6/14(木) 22:43 発言[未読]
【49726】Re:フォルダ配下のファイルからデータを転... momo 07/6/18(月) 22:44 発言[未読]
【49731】Re:フォルダ配下のファイルからデータを転... ウッシ 07/6/18(月) 23:57 発言[未読]
【49754】Re:フォルダ配下のファイルからデータを転... momo 07/6/19(火) 21:25 発言[未読]
【49760】Re:フォルダ配下のファイルからデータを転... Kein 07/6/20(水) 16:55 回答[未読]
【49862】Re:フォルダ配下のファイルからデータを転... momo 07/6/25(月) 21:15 お礼[未読]
【49625】フォルダ配下のファイルからデータを転記...
質問  momo  - 07/6/13(水) 21:26 -
引用なし
パスワード
   こんばんは。
フォルダ配下のファイルのデータを転記したいので
どなたかご教授くださいますでしょうか。

北高校 − 1_1 − 千葉県 − 田中一郎.xls
　　　　　　　　 東京都 − 谷口次郎.xls　
　　　　　
　　　　　1_2 − 千葉県 − 山田花子.xls
　　　　　　　　 東京都 − 青田紀子.xls　　　　　　　　
　　　　　
　　　　　1_3 − 千葉県 − 佐藤市子.xls
　　　　　　　　 東京都 − 金田幸樹.xls

上記のような階層でxlsファイルがあります。
北高校というフォルダの下に
1_1,1_2,1_3・・・という1年1組とかの略で書いたフォルダが多数あります。
さらにその下に千葉県や東京都・・といった県の名前をつけたフォルダが
あり、各県の下にはその県から通っている生徒の名前が付いたエクセルファイルがあります。　　　　　

生徒の名前がついたエクセルファイルの”情報”というシートから
A1に入っている氏名とB1に入っている住所を
別ブックに転記したいと思っています。

たとえば
千葉県に住んでいる田中、山田、佐藤の情報は

管理.xlsという別ブックの”千葉”というシートに転記

A　　　B
氏名　住所
田中　千葉県浦安市・・・・
山田　千葉県我孫子市・・・
佐藤　千葉県成田市・・・

このような結果になるコードを考えています。

1_1とかのフォルダ名は変更する可能性がありますので
指定できないですし、エクセルファイルの名前についても指定せずに
千葉県のフォルダに入っているエクセルファイルをすべてとるという形に、
というむずかしいことはできるのでしょうか？

宜しくお願い致します。
【49626】Re:フォルダ配下のファイルからデータを...
発言  ウッシ  - 07/6/13(水) 23:14 -
引用なし
パスワード
   こんばんは

管理.xlsにマクロをセットするとして、
管理.xlsと同じフォルダ内に「北高校」フォルダがあるとして、
「北高校」フォルダ以下には各都道府県フォルダ内にしかExcelファイルが無いとして、
管理.xlsには各都道府県フォルダと完全に同じ名前のシートがあるとして、
その各都道府県名シートの1行目には
A　　　B
氏名　住所
のように項目名が入っているとして、

Sub test()
　　Dim sFile As String
　　Dim i　　 As Long
　　Dim fso　 As Object
　　Dim s　　 As String
　　
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　With Application.FileSearch
　　　　.NewSearch
　　　　.LookIn = ThisWorkbook.Path & "\北高校"
　　　　.SearchSubFolders = True
　　　　.FileName = "*.xls"
　　　　.MatchTextExactly = True
　　　　If .Execute() > 0 Then
　　　　　　For i = 1 To .FoundFiles.Count
　　　　　　　　sFile = fso.GetParentFolderName(.FoundFiles(i))
　　　　　　　　sFile = "='" & sFile & "\[" & Dir(.FoundFiles(i)) & _
　　　　　　　　　　　　"]情報'!"
　　　　　　　　s = fso.GetFile(.FoundFiles(i)).ParentFolder.Name
　　　　　　　　With Worksheets(s).Cells(65536, 1).End(xlUp)
　　　　　　　　　　.Offset(1).Formula = sFile & "R1C1"
　　　　　　　　　　.Offset(1).Value = .Offset(1).Value
　　　　　　　　　　.Offset(1, 1).Formula = sFile & "R1C2"
　　　　　　　　　　.Offset(1, 1).Value = .Offset(1, 1).Value
　　　　　　　　End With
　　　　　　Next
　　　　End If
　　End With
　　Set fso = Nothing
End Sub
【49655】Re:フォルダ配下のファイルからデータを...
発言  momo  - 07/6/14(木) 21:20 -
引用なし
パスワード
   ▼ウッシ さん：
こんばんは。
ありがとうございます。

大変申し訳御座いません。
書き方が悪く（書き足りなく）、再度質問してしまいます。
>
>管理.xlsにマクロをセットするとして、
>管理.xlsと同じフォルダ内に「北高校」フォルダがあるとして、
>「北高校」フォルダ以下には各都道府県フォルダ内にしかExcelファイルが無いとして、

の部分なのですが、各都道府県と同じ階層には
xlsやzipファイルなどが存在しています。
その階層部分だけを書くと下記のようになります。

−千葉県
−東京都　
−てすと.xls
−進路.zip


また、管理.xlsには千葉県だけの生徒情報がほしいのですが
”千葉県”というフォルダ指定にするにはどこを書き換えたらよいのでしょうか？
（転記先のほうはｓから書き換えさせていただきました）
どうぞ宜しくお願い致します。


>Sub test()
>　　Dim sFile As String
>　　Dim i　　 As Long
>　　Dim fso　 As Object
>　　
>　　Set fso = CreateObject("Scripting.FileSystemObject")
>　　With Application.FileSearch
>　　　　.NewSearch
>　　　　.LookIn = ThisWorkbook.Path & "\北高校"
>　　　　.SearchSubFolders = True
>　　　　.FileName = "*.xls"
>　　　　.MatchTextExactly = True
>　　　　If .Execute() > 0 Then
>　　　　　　For i = 1 To .FoundFiles.Count
>　　　　　　　　sFile = fso.GetParentFolderName(.FoundFiles(i))
>　　　　　　　　sFile = "='" & sFile & "\[" & Dir(.FoundFiles(i)) & _
>　　　　　　　　　　　　"]情報'!"
>　　　　　　　　With Worksheets("千葉県").Cells(65536, 1).End(xlUp)
>　　　　　　　　　　.Offset(1).Formula = sFile & "R1C1"
>　　　　　　　　　　.Offset(1).Value = .Offset(1).Value
>　　　　　　　　　　.Offset(1, 1).Formula = sFile & "R1C2"
>　　　　　　　　　　.Offset(1, 1).Value = .Offset(1, 1).Value
>　　　　　　　　End With
>　　　　　　Next
>　　　　End If
>　　End With
>　　Set fso = Nothing
>End Sub
【49657】Re:フォルダ配下のファイルからデータを...
発言  ウッシ  - 07/6/14(木) 22:43 -
引用なし
パスワード
   こんばんは

sは転記先という意味だけでは無いですよ。

各Excelファイルの格納フォルダ名を取得していますので、sが「千葉県」の時だけ
処理するようにすれば、

Sub test1()
　　Dim sFile As String
　　Dim i　　 As Long
　　Dim fso　 As Object
　　Dim s　　 As String
　　
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　With Application.FileSearch
　　　　.NewSearch
　　　　.LookIn = ThisWorkbook.Path & "\北高校"
　　　　.SearchSubFolders = True
　　　　.FileName = "*.xls"
　　　　.MatchTextExactly = True
　　　　If .Execute() > 0 Then
　　　　　　For i = 1 To .FoundFiles.Count
　　　　　　　　s = fso.GetFile(.FoundFiles(i)).ParentFolder.Name
　　　　　　　　If s = "千葉県" Then
　　　　　　　　　　sFile = fso.GetParentFolderName(.FoundFiles(i))
　　　　　　　　　　sFile = "='" & sFile & "\[" & Dir(.FoundFiles(i)) & _
　　　　　　　　　　　　　　"]情報'!"
　　　　　　　　　　s = fso.GetFile(.FoundFiles(i)).ParentFolder.Name
　　　　　　　　　　With Worksheets(s).Cells(65536, 1).End(xlUp)
　　　　　　　　　　　　.Offset(1).Formula = sFile & "R1C1"
　　　　　　　　　　　　.Offset(1).Value = .Offset(1).Value
　　　　　　　　　　　　.Offset(1, 1).Formula = sFile & "R1C2"
　　　　　　　　　　　　.Offset(1, 1).Value = .Offset(1, 1).Value
　　　　　　　　　　End With
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　End With
　　Set fso = Nothing
End Sub
【49726】Re:フォルダ配下のファイルからデータを...
発言  momo  - 07/6/18(月) 22:44 -
引用なし
パスワード
   ▼ウッシ さん：
こんばんは。
ご丁寧にありがとうございます。
また返事が遅れたこと、お詫び致します。

もうひとつだけ質問させてください。
タイトルと違うので非常に恐縮なのですが
別に質問するとわからなくなってしまうので
ここに書きました。

With Worksheets(s).Cells(65536, 1).End(xlUp)
　　　　.Offset(1).Formula = sFile & "R1C1"
　　　　.Offset(1).Value = .Offset(1).Value
End With

の部分なのですが

.Offset(1).Formula =sFile & "R" & cells(65536,1).End(xlup).Row & "C1"
で最終行をとるように書きなおしてみました。（すみません。）
"R1C1"の書き方ではセル値だけできちんと千葉県の生徒の氏名がとられてくるのに
最終行のセル値を指定する方法では管理.xlsの最終行をとってくるのでしょうか？


For i = 1 To .FoundFiles.Count
s = fso.GetFile(.FoundFiles(i)).ParentFolder.Name
If s = "千葉県" Then

sFile = fso.GetParentFolderName(.FoundFiles(i))
sFile = "='" & sFile & "\[" & Dir(.FoundFiles(i)) & _
　　　　　　　　　　　　　"]情報'!"
s = fso.GetFile(.FoundFiles(i)).ParentFolder.Name
　　

このあたりがまだ理解できていないのが原因だと思います。
少し解説をお願いしてよろしいでしょうか？

sはxlsファイルの上の千葉県とかのフォルダ名をとっているんですよね？
sFileのGetParentFolderNameも千葉県とかのフォルダですか？？
1_1とかのフォルダはどこで指定？されているのでしょうか？

お手数をおかけします。
よろしくお願いいたします。
【49731】Re:フォルダ配下のファイルからデータを...
発言  ウッシ  - 07/6/18(月) 23:57 -
引用なし
パスワード
   こんばんは

何が聞きたいのか分かりません。
>cells(65536,1).End(xlup).Row
は、アクティブになっているシートのA列の最終行という意味になります。

取り敢えず、コードの説明だけ。
と言っても、momoさんの質問文を当てはめただけですけど。

Sub test1()
　　Dim sFile As String
　　Dim i　　 As Long
　　Dim fso　 As Object
　　Dim s　　 As String
　　
　　'FileSystemObject生成
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　With Application.FileSearch
　　　　'北高校というフォルダと
　　　　'その下の全てのフォルダ
　　　　'内のExcelファイルを
　　　　'検索する。
　　　　.NewSearch
　　　　.LookIn = ThisWorkbook.Path & "\北高校"
　　　　.SearchSubFolders = True
　　　　.FileName = "*.xls"
　　　　.MatchTextExactly = True
　　　　'Excelファイルが存在したら
　　　　If .Execute() > 0 Then
　　　　　　'そのファイル数だけループし
　　　　　　For i = 1 To .FoundFiles.Count
　　　　　　　　'それぞれの親フォルダ名を取得し
　　　　　　　　s = fso.GetFile(.FoundFiles(i)).ParentFolder.Name
　　　　　　　　'そのフォルダ名「千葉県」の時
　　　　　　　　If s = "千葉県" Then
　　　　　　　　　　'そのフォルダへのフルパスを取得し
　　　　　　　　　　sFile = fso.GetParentFolderName(.FoundFiles(i))
　　　　　　　　　　'該当したExcelファイルの「情報」シートへの参照式を生成する。
　　　　　　　　　　sFile = "='" & sFile & "\[" & Dir(.FoundFiles(i)) & _
　　　　　　　　　　　　　　"]情報'!"
　　　　　　　　　　With Worksheets(s).Cells(65536, 1).End(xlUp)
　　　　　　　　　　　　'管理.xlsの「千葉県」シートのA列最終行
　　　　　　　　　　　　'の一つ下のセルへ「情報」シートのセルA1
　　　　　　　　　　　　.Offset(1).Formula = sFile & "R1C1"
　　　　　　　　　　　　'への参照式をセットし、値に変換する。
　　　　　　　　　　　　.Offset(1).Value = .Offset(1).Value
　　　　　　　　　　　　'A列最終行の一つしたの一つ右のセルへ
　　　　　　　　　　　　'「情報」シートのセルB1への参照式をセット
　　　　　　　　　　　　.Offset(1, 1).Formula = sFile & "R1C2"
　　　　　　　　　　　　'し、値に変換する。
　　　　　　　　　　　　.Offset(1, 1).Value = .Offset(1, 1).Value
　　　　　　　　　　End With
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　End With
　　Set fso = Nothing
End Sub
【49754】Re:フォルダ配下のファイルからデータを...
発言  momo  - 07/6/19(火) 21:25 -
引用なし
パスワード
   ▼ウッシ さん：
こんばんは。
ありがとうございます。
説明を書いていただいたので
理解が深まりました。

>何が聞きたいのか分かりません。
>>cells(65536,1).End(xlup).Row
>は、アクティブになっているシートのA列の最終行という意味になります。

申し訳ありませんでした。

.Offset(1, 1).Formula = sFile & "R1C1"
名前が記入されているA1をA列最終行に変更したかったのです。

"R1"の代わりに
"R" & cells(65536,1).End(xlup).Row
を書きました。

よく考えると
>アクティブになっているシートのA列の最終行という意味になります。
そうですよね。
【49760】Re:フォルダ配下のファイルからデータを...
回答  Kein  - 07/6/20(水) 16:55 -
引用なし
パスワード
   コマンド・プロンプトの "DIRコマンド" を使うコードです。
管理.xlsに入れて試してみて下さい。
ただし、そちらに「似た条件」のテストしかしていませんので、あしからず。

Sub Test_COM_DIR()
　 Dim WshShell As Object, oExec As Object
　 Dim i As Long, Pt As Long
　 Dim St As String, Lk As String
　 Const CmdSt As String = _
　 "CMD.EXE /C DIR ""C:\北高校\*.xls"" /S /B"
　　
　 With Application
　　　.ScreenUpdating = False
　　　.DisplayAlerts = False
　 End With
　 Set WshShell = CreateObject("WScript.Shell")
　 Set oExec = WshShell.Exec(CmdSt): i = 1
　 With Worksheets("千葉")
　　　.Cells.ClearContents
　　　Do Until oExec.StdOut.AtEndOfStream
　　　　 St = oExec.StdOut.ReadLine
　　　　 If InStr(1, St, "千葉県") > 0 Then
　　　　　　Pt = InStrRev(St, "\")
　　　　　　Lk = "='" & Left$(St, Pt) & "[" & _
　　　　　　Mid$(St, Pt + 1) & "]情報'!A1"
　　　　　　i = i + 1
　　　　　　With .Cells(i, 1).Resize(, 2)
　　　　　　　 .Formula = Lk
　　　　　　　 .Value = .Value
　　　　　　End With
　　　　 End If
　　　Loop
　　　.Range("A1:B1").Value = Array("氏名", "住所")
　 End With
　 Set oExec = Nothing: Set WshShell = Nothing
　 With Application
　　　.ScreenUpdating = True
　　　.DisplayAlerts = True
　 End With
End Sub
【49862】Re:フォルダ配下のファイルからデータを...
お礼  momo  - 07/6/25(月) 21:15 -
引用なし
パスワード
   ウッシさん、Keinさん
遅くなりましたが、、
ご丁寧にありがとうございました。

無事解決いたしました。
勉強になりました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5614 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free