Excel VBA質問箱 IV

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

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


32242 / 76734 ←次へ | 前へ→

【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
8 hits

【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 お礼

32242 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free