Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

32315 / 76734

←次へ　｜　前へ→


	【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

3 hits

▼

【49625】フォルダ配下のファイルからデータを転記したいのですが・・・ momo 07/6/13(水) 21:26