[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『【追加質問】ファイル名を抽出して指定セルの値も抽出するの可能?』(まりん)
ファイル名の抽出は [[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つのブックには3つのシートが必ずあるとして、
A B C 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 ←コードの2つ目に書いてあるこの1行を消して下さい。(1つ目はそのまま) End If (じゅんじゅん)
じゅんじゅん様 昨日に引き続きありがとうございます! 抽出したリストをそのまま使いたい場合と、並べ替えて別表に移したい場合とが出てきたので 質問させていただきました。 ありがとうございました! (まりん)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.