[[20071203133339]]　『【追加質問】ファイル名を抽出して指定セルの値も』（まりん）　ページの最後に飛ぶ

『【追加質問】ファイル名を抽出して指定セルの値も抽出するの可能？』（まりん）

 ファイル名の抽出は
[[20050324161946]] 『指定したフォルダのファイルリストを作りたい』(HIDE)を
 利用してできました。

 ファイル名ではなく、各ファイルの指定セルの値を抽出してリスト化することって可能なんですか？

 Excel2002、WindowsXPを使用しています。

 >各ファイルの指定セルの値
 指定セルとは、セルアドレスを任意に与えたいと言う事でしょうか？
 シート構成など提示されたらわかりやすいかもです。

 ＊一部修正させて頂きました。
 (じゅんじゅん)

 じゅんじゅん様、コメントありがとうございます。
 セルアドレスではなく、セルの値そのままをリスト化したいのです。

 部品を発注する注文書になるのですが、シート構成は以下になります。
 すべて「12月」というフォルダにあるものとします。
 ブック1（A機種)に、Sheet1(A社)、Sheet2(B社)、Sheet3(C社)と3つのシートがあり、
 それぞれ、Y機種ですが違う部品を発注することになり、セルD20に算出された発注合計金額だけを別ブック・シートでリスト化させたいのです。
 機種(ブック)はAから始まり、だいたいTぐらいまでの20機種ぐらいありますが、月によって変動します。

 Sheet1(A社)の表は以下のとおりです。
 Sheet2(B社)とSheet3(C社)はA列の部品名が変わります。

 　　A　　 　B　　　C　　 D
 1　部品1　発注数　単価　金額
 2  部品2
 :
 :
 20　　　　　　　　　　　発注合計金額

 （まりん）

 １つのブックには３つのシートが必ずあるとして、

 　　Ａ　　　　Ｂ　　　　Ｃ
 1ファイル名 シート名 発注合計金額
 以下書き出す。
 ただし、実行時には読み込むフォルダを指定する。

 Sub test()
     Dim myObj As Object
     Dim ws As Worksheet
     Dim Fn As String, Fp As String
     Dim i As Long, j As Integer

 Application.ScreenUpdating = False

 Set myObj = CreateObject("Shell.Application"). _
 BrowseForFolder(0, "フォルダを選択してください", 0)

 If myObj Is Nothing Then Exit Sub

 Set ws = ActiveSheet
 Fp = myObj.Items.Item.Path & "\"  '保存場所のパス
 Fn = Dir(Fp & "*.xls", 0)

 With ws
      .Range("A1").Value = "ファイル名"
      .Range("B1").Value = "シート名"
      .Range("C1").Value = "発注合計金額"
 End With
 i = 2

    Do Until Fn = ""

       If Fn <> ThisWorkbook.Name Then
          Cells(i, "A").Value = Fn

          With Application.Workbooks.Open(Fp & Fn)
               For j = 1 To 3
                   ws.Cells(i, "B").Value = _
                     .Worksheets(j).Name
                   ws.Cells(i, "C").Value = _
                     .Worksheets(j).Range("D20").Value
                   i = i + 1
               Next
               .Close SaveChanges:=False
          End With
          i = i + 1
       End If
       Fn = Dir()
    Loop
 Application.ScreenUpdating = True
 End Sub
 では、どうでしょう？
 (じゅんじゅん)

 じゅんじゅん様
 早速のコメント、ありがとうございます。
 組み込んでみたら、できました！ありがとうございます！
 ちなみに、ファイル名の拡張子「.xls」を表示させないようにすることは可能ですか？
 （まりん）

 >Cells(i, "A").Value = Fn
  Cells(i, "A").Value = Left(Fn,Len(Fn)-4)
 とかかな。
 (じゅんじゅん)

 じゅんじゅん様
 早速のコメント、ありがとうございます。
 無事に拡張子を非表示にすることができました！ありがとうございます！
 基本形がわかったのであともうちょっと手を加えて完成させたいと思います。
 いろいろとありがとうございました！
 わからなくなった時はまたやって来ますので（笑）宜しくお願いします！
 （まりん）

 >  ブック1（A機種)に、Sheet1(A社)、Sheet2(B社)、Sheet3(C社)と3つのシートがあり、
 それぞれ、Y機種ですが違う部品を発注することになり、セルD20に算出された発注合計金額だけを別ブック・シートでリスト化させたいのです。

 はずしているならパスしてください。
 開かなくてもよいのでは？

 Sub test()
 Dim myDir As String, fn As String, i As Byte
 myDir = "c:\test"  '<- 要変更
 fn = Dir(myDir & "\*.xls")
 Do While fn <> ""
     If fn <> ThisWorkbook.Name Then
         With ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp)
             For i = 1 To 3
                 .Offset(i).Formula = "='" & myDir & "\[" & fn & "]Sheet" & i & "'!D20"
                 .Offset(i,1).Value = Replace(fn,".xls","")
             Next
         End With
     End If
     fn = Dir
 Loop
 End Sub
 (seiya)

 >開かなくてもよいのでは？
 たしかそんな方法があったと思っていながら、出てこなかったんです。
 定位置ですから、そうですよね。
 メモしておきます。
 (じゅんじゅん)

 seiya様
 コメントありがとうございます。
 こういうやり方もあるんですねー。みなさんすごいです（笑）
 アタシもメモしておきます。
 （まりん）

 昨日の続きで申し訳ないのですが質問です！
 じゅんじゅんさんが教えてくれたもの（一番最初の）で抽出できたのですが
 抽出してリスト化した際に1行空白行ができてしまいます。
 この空白行無しでリスト化することは可能ですか？
 （まりん）

 ファイルの区切りでつけてみたのでしたが、不要であれば

          End With
          i = i + 1　←コードの２つ目に書いてあるこの１行を消して下さい。（１つ目はそのまま）
       End If
 (じゅんじゅん)

 じゅんじゅん様
 昨日に引き続きありがとうございます！
 抽出したリストをそのまま使いたい場合と、並べ替えて別表に移したい場合とが出てきたので
 質問させていただきました。
 ありがとうございました！
 （まりん）

コメント返信：

[ 一覧(最新更新順) ]

[[20071203133339]] 『【追加質問】ファイル名を抽出して指定セルの値も』（まりん） ページの最後に飛ぶ

[[20071203133339]]　『【追加質問】ファイル名を抽出して指定セルの値も』（まりん）　ページの最後に飛ぶ