Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
10061 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【23081】数あるファイルの中から もえ 05/3/12(土) 13:02 質問[未読]
【23088】Re:数あるファイルの中から かみちゃん 05/3/12(土) 19:14 発言[未読]
【23418】Re:数あるファイルの中から もえ 05/3/22(火) 16:53 質問[未読]
【23439】Re:数あるファイルの中から kazu 05/3/23(水) 13:21 発言[未読]
【23941】Re:数あるファイルの中から もえ 05/4/8(金) 12:39 発言[未読]
【23942】Re:数あるファイルの中から m2 05/4/8(金) 13:00 回答[未読]
【23943】Re:数あるファイルの中から ウッシ 05/4/8(金) 13:01 発言[未読]
【23944】Re:数あるファイルの中から kazu 05/4/8(金) 13:12 発言[未読]
【23945】Re:数あるファイルの中から ウッシ 05/4/8(金) 13:31 回答[未読]
【23442】Re:数あるファイルの中から A 05/3/23(水) 13:39 回答[未読]
【23081】数あるファイルの中から
質問  もえ  - 05/3/12(土) 13:02 -
引用なし
パスワード
   はじめまして！エクセルデータの整理について質問させて頂きたく宜しくお願い致します。

沢山あるエクセルの中のとあるセルの数値だけ抜取り、別のエクセルファイルに挙列させるようなマクロの作成はできないでしょうか？
そのファイルは日付ごとのファイル名になっており、各ファイルのデータを一気に抜き出したいのです。。。
各ファイルは一つのフォルダの中に入っていますが、一つ一つ開いて、コピー/貼付けだと膨大な時間が掛かってしまいます。
どうか宜しくお願い致します。

尚、各ファイルは同様形式であり、どのファイルもC24のデータを抜き出したいのです。
【23088】Re:数あるファイルの中から
発言  かみちゃん  - 05/3/12(土) 19:14 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>沢山あるエクセルの中のとあるセルの数値だけ抜取り、別のエクセルファイルに挙列させるようなマクロの作成はできないでしょうか？
>そのファイルは日付ごとのファイル名になっており、各ファイルのデータを一気に抜き出したいのです。。。
>各ファイルは一つのフォルダの中に入っていますが、一つ一つ開いて、コピー/貼付けだと膨大な時間が掛かってしまいます。

とりあえず、以下の過去ログを参考にしてみてください。
まずは、特定のファイルの特定のシートの特定のセルの値をファイルを開かずに取得する方法です。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=17856;id=excel

あとは、そのたくさんあるファイル名をどのように取得していくかだと思います。
【23418】Re:数あるファイルの中から
質問  もえ  - 05/3/22(火) 16:53 -
引用なし
パスワード
   過去ログ参照させて頂きました。
大まかには理解できました。
･･･が、一つのファイルについてではなく、フォルダ内にある沢山のファイルについて、全てC24のデータを抜き出し、挙列さたいのです。

ファイルの選択でフォルダまで選択し、その中にあるファイルの全てのC24を挙列する方法は無いのでしょうか。。。それと同時にファイル名を抜き出し、そのデータの隣の列に挙列させる方法もおあればご教授下さい。
宜しくお願い致します。

例）

ファイル名　　データ
　2/12　　　　4.345　¬
　3/11　　　 4.445　 ｜
　3/14　　　 4.435　 ｜
　3/15　　　 4.501　 ｜　抜き出したいデータです。　
　 ・　　　　　・　　 ｜
　 ・　　　　　・　　 ｜
　 ・　　　　　・
【23439】Re:数あるファイルの中から
発言  kazu  - 05/3/23(水) 13:21 -
引用なし
パスワード
   ▼もえ さん：

特定のﾌｫﾙﾀﾞの中にあるﾌｧｲﾙを調べるには　Dir　が使えます。
エクセルﾌｧｲﾙ指定であれば↓みたいな感じ。
Fil = Dir(ﾌｫﾙﾀﾞ名　&　"*.xls")

全て抜き出すという事に関しては、　Do　〜　Loop　が使えます。
Filが空白文字を返す迄連続処理するのであればこんな感じ。
Do Until Fil = ""
　　処理内容がここに入ります。
Loop

詳細はHelpを参照してみて下さい。

これらとかみちゃんのレスで何とか頑張れませんか？
解らなければソースを提示しますが・・・。
【23442】Re:数あるファイルの中から
回答  A  - 05/3/23(水) 13:39 -
引用なし
パスワード
   ディレクトリ内ファイルをすべてコレクションに格納したあとで
for each で回します。
【23941】Re:数あるファイルの中から
発言  もえ  - 05/4/8(金) 12:39 -
引用なし
パスワード
   ▼kazu さん：

返信遅くなりまして申し訳ないです。

kazuさんの助言を頂いて頑張ってみましたが、どうも上手くいかないのです（泣）
・・・もう少し頑張ってみます。。。
【23942】Re:数あるファイルの中から
回答  m2  - 05/4/8(金) 13:00 -
引用なし
パスワード
   雰囲気を入れます。
　ブックのシートが不明です。


Public sh1 As Object
Public sh2 As Object
Public cnt As Integer

Sub Get_DIR()

　Dim MyPath As String, MyName As String
　Set sh1 = Workbooks(1)
　
　MyPath = ThisWorkbook.Path
　MyName = Dir(MyPath & "\Book*.xls")
　Do While MyName <> ""
　　 Workbooks.Open Filename:=MyPath & "\" & MyName
　　
　　　Set sh2 = Workbooks(2)
　　　
　　　Call m2_SUB(MyName)
　　 sh2.Close
　　 MyName = Dir
　Loop
　End Sub
　
Sub m2_SUB(MyName)
　Dim 計 As Long
　 計 = 0
　Dim WS As Worksheet

　 For Each WS In sh2.Worksheets

　cnt = 1 + cnt
　sh1.Sheets("Sheet1").Range("A" & cnt) = sh2.Sheets(WS.Name).Range("c24")

　Next

End Sub
【23943】Re:数あるファイルの中から
発言  ウッシ  - 05/4/8(金) 13:01 -
引用なし
パスワード
   こんにちは

シートは、その日付ごとのファイルそれぞれ1枚ですか？
また、シート名は同一ですか？
【23944】Re:数あるファイルの中から
発言  kazu  - 05/4/8(金) 13:12 -
引用なし
パスワード
   ▼もえ さん：

Sheet1を対象に処理すると考えると・・・。
こんな感じになると思います。
Split97は　Splitの代用関数なので　エクセルが2000以降ならSplitを使って下さい。


Sub S()
i = 2
AryFil = Application.GetOpenFilename("(*.XLS),*.XLS", , "ﾌｧｲﾙ選択", , True)

If Not IsArray(AryFil) Then
　　MsgBox "ﾌｧｲﾙを選択してから実行して下さい。"
　　Exit Sub
End If

For Each Fil In AryFil

FilTmp = Split97(Fil, "\")

F_Nm = FilTmp(UBound(FilTmp))
F_Pth = Left(Fil, Len(Fil) - Len(F_Nm))


With Range("A" & i)
　.FormulaR1C1 = "='" & F_Pth & "[" & F_Nm & "]Sheet1'!R2C1"
　.Value = .Value
End With
i = i + 1
Next

End Sub

Function Split97(ByVal StrTmp, ByVal Strbunri)
　　Dim Split97Tmp()　　'配列一時格納用
　　Dim i As Long　　　 'カウンタ変数
　　Dim IntTmp As Long　'区切り文字位置格納用変数
　　
　　IntTmp = InStr(1, StrTmp, Strbunri)
　　If IntTmp = 0 Then
　　　　ReDim Split97Tmp(0)
　　　　Split97Tmp(0) = StrTmp
　　Else
　　　　Do Until IntTmp = 0
　　　　　　ReDim Preserve Split97Tmp(i)
　　　　　　Split97Tmp(i) = Left(StrTmp, IntTmp - 1)
　　　　　　i = i + 1
　　　　　　StrTmp = Mid(StrTmp, IntTmp + Len(Strbunri))
　　　　　　IntTmp = InStr(1, StrTmp, Strbunri)
　　　　Loop
　　　　ReDim Preserve Split97Tmp(i)
　　　　Split97Tmp(i) = StrTmp
　　End If
　　
　　Split97 = Split97Tmp
End Function
【23945】Re:数あるファイルの中から
回答  ウッシ  - 05/4/8(金) 13:31 -
引用なし
パスワード
   こんにちは

各ファイルの「Sheet1」のC24を抽出すると決め打ちして、

Sub test()
　　Dim mShell　　As Object
　　Dim mFol　　　As Object
　　Dim FolPath　 As String
　　Dim fso　　　 As Object
　　Dim mF　　　　As Object
　　Dim f　　　　 As Object
　　Dim i　　　　 As Long
　　Dim sSh　　　 As Worksheet
　　
　　Set sSh = ThisWorkbook.Worksheets("Sheet1")
　　
　　Set mShell = CreateObject("Shell.Application")
　　Set mFol = mShell _
　　　　.BrowseForFolder(0, "フォルダを選択して下さい", 0)
　　If mFol Is Nothing Then Exit Sub
　　FolPath = mFol.Items().Item().Path
　　Set mFol = Nothing
　　Set mShell = Nothing
　
　　With Application
　　　　.ScreenUpdating = False
　　　　Set fso = CreateObject("Scripting.FileSystemObject")
　　　　Set mF = fso.GetFolder(FolPath).Files
　　　　i = 1
　　　　On Error Resume Next
　　　　For Each f In mF
　　　　　　If StrConv(fso.GetExtensionName(f.Name), vbLowerCase) = "xls" Then
　　　　　　　　sSh.Cells(i, 1) = Left(f.Name, Len(f.Name) - 4)
　　　　　　　　sSh.Cells(i, 2) = Application.ExecuteExcel4Macro( _
　　　　　　　　　　"'" & FolPath & "\[" & f.Name & "]Sheet1'!R24C3")
　　　　　　　　i = i + 1
　　　　　　End If
　　　　Next
　　　　.ScreenUpdating = True
　 End With
　 Set fso = Nothing
　 Set mF = Nothing
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
10061 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free