ついに夏本番！さぁ、家族でキャンプに行くぞ！ ＞＞

ＶＢＡで複数ファイルからのデータ抽出を行いたい。

解決済

  • 質問者：pleasure95
  • 質問日時：2009/05/14 17:02
  • 回答数：1件

すみません、知恵をお貸しください。

ＶＢＡ初心者です。
一つの同じフォルダ内にあるエクセルの同じ形式の複数ファイル（*.xls)から、データを抽出し（例．A2:k2）一つのファイルを作成したいのですが、どうにか一行目だけを抽出することができました。

しかし、データ抽出をしたい複数ファイルの中には（A2:k2)だけではなく、複数行に渡りデータが入っているもの（A3:k3まで、やA5:k5までなど）があり、それら全てを抽出したいのです。

何らかの条件付けの上でループをさせればいいのかな？とも考えたのですが、うまくいきません。

どうかご教授お願いします。

通報する

この質問への回答は締め切られました。

質問の本文を隠す

このQ&Aに関連する最新のQ&A

「VBA 抽出」に関するQ&A： EXCEL VBA データを抽出して別シートへ貼り付ける方法

さらに表示

「データ 抽出」に関するQ&A： EXCELのデータ抽出の方法を教えて下さい。

A 回答 (1件)

No.1ベストアンサー

  • 回答者： bluecampus
  • 回答日時：2009/05/14 17:06

http://www.niji.or.jp/home/toru/notes/8.html
が参考になるかも。
    • good
    • 0
    • 件
通報する
この回答へのお礼

ありがとうございます☆
すごく参考になりました^^

通報する
お礼日時：2009/05/19 14:26

このQ&Aに関連する人気のQ&A

「データ 抽出」に関するQ&A： 複数のエクセルファイルからデータ抽出とまとめる方法について。

さらに表示

「VBA 抽出」に関するQ&A： エクセルＶＢＡでフィルタ抽出部分のみのコピー

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

Q質問する（無料）

このQ&Aを見た人はこんなQ&Aも見ています

関連するQ&A

関連するカテゴリからQ&Aを探す

専門家回答数ランキング

専門家

※過去一週間分の回答数ランキングです。

Q質問する（無料）

他の専門家の回答をチェック

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q複数のエクセルファイルからデータ抽出とまとめる方法について。

500のエクセルファイルがあり、それぞれのエクセルデータのＡ２からＦ２までのデータのをまとめた一覧表（１行目は、１枚目のエクセルファイルのＡ２－Ｆ２、２行目は２枚目のエクセルファイルの・・・、という感じでです）のを、新しいエクセルファイルもしくはテキストなどにでも手早く作れる方法をご存知の方、ご教授ください。コピペでやっていますが嫌になってしまいました。。マクロも触っては見たのですが、２枚目のエクセルファイルを２行目に、３枚目のエクセルファイルを３行目になどの方法の解決は思いつかず、挫折しました。よろしくお願いいたします

Aベストアンサー

対象のフォルダをｃドライブの「sample」とした場合で回答します。
新規エクセルブックのシート名タブを右クリックし「コードの表示」
右側のエディタエリアに下記コードを貼り付け、実行して下さい。
Ｇ列にファイル名が入るようになっています。不要であれば
Cells(rIdx, 7).Value = fName
を削除して下さい。


Sub getA_F()
Const myPath As String = "c:\sample\"
Dim rIdx As Long
Dim fName As String
fName = Dir(myPath & "*.xls")
Do Until fName = ""
Workbooks.Open Filename:=myPath & fName
rIdx = rIdx + 1
Me.Range(Cells(rIdx, 1), Cells(rIdx, 6)).Value = ActiveSheet.Range("A2:F2").Value
Cells(rIdx, 7).Value = fName
Windows(fName).Close
fName = Dir
Loop
End Sub

対象のフォルダをｃドライブの「sample」とした場合で回答します。
新規エクセルブックのシート名タブを右クリックし「コードの表示」
右側のエディタエリアに下記コードを貼り付け、実行して下さい。
Ｇ列にファイル名が入るようになっています。不要であれば
Cells(rIdx, 7).Value = fName
を削除して下さい。


Sub getA_F()
Const myPath As String = "c:\sample\"
Dim rIdx As Long
Dim fName As String
fName = Dir(myPath & "*.xls")
Do Until fName = ""
Workbooks.Open ...続きを読む

他の回答も見る

QExel VBA　別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列　　　　 B列　　　　　C列　　　　　　
商品名　　商品番号　　コード
モータ　　U-1325-L　　
ホルダ　　R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル（B列のコード）の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
　　Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列　　　　 B列　　　　　C列　　　　　　
商品名　　商品番号　　コード
モータ　　U-1325-L　　
ホルダ　　R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
　Application.ScreenUpdating = False
　Dim I As Long
　Dim xlBook
　Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
　I = 2
　Do While Range("A" & I).Value <> ""
　　ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
　　I = I + 1
　Loop
　xlBook.Close
　Application.ScreenUpdating = True
　MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
　Application.ScreenUpdating = False
　Dim I As Long
　Dim xlBook
　Set xlBook = Workbooks....続きを読む

他の回答も見る

Q複数のエクセルファイルとシートからデータ抽出したい

すみませんが教えてください！
複数のエクセルファイルがあり、それぞれに複数のシートがあります。
（ファイルによってシート数は異なります）
そのすべてのファイル／シートから、C列の最後の行のデータを抽出し、集計ファイルに書き出したいのです。
書き出しのフォーマットは3セル使用して、ファイル名、シート名、データとしたいです。
すみませんが、よろしくお願いいたします。

Aベストアンサー

集計用のブックを用意する
Sheet1のＡ１、Ｂ１、Ｃ１セルに「ファイル名」「シート名」「データ」と記入しておく
集計ブックを、あなたの「複数のエクセルファイル」が放り込んであるフォルダに一緒に保存しておく


改めて集計ブックを開く
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim myPath as string
　dim myFile as string
　dim w as worksheet

　mypath = thisworkbook.path & "\"
　myfile = dir(mypath & "*.xls*")
　application.screenupdating = false
　do until myfile = ""
　　if myfile <> thisworkbook.name then
　　　workbooks.open mypath & myfile
　　　for each w in workbooks(myfile).worksheets
　　　with thisworkbook.worksheets("Sheet1").range("A65536").end(xlup).offset(1)
　　　　.value = myfile
　　　　.offset(0, 1) = w.name
　　　　.offset(0, 2).value = w.cells(w.rows.count, "C").end(xlup).value
　　　end with
　　　next
　　　workbooks(myfile).close false
　　end if
　　myfile = dir()
　loop
　application.screenupdating = true
end sub

ファイルメニューから終了してエクセルに戻る
ＡＬＴ＋Ｆ８を押してマクロを実行する。

集計用のブックを用意する
Sheet1のＡ１、Ｂ１、Ｃ１セルに「ファイル名」「シート名」「データ」と記入しておく
集計ブックを、あなたの「複数のエクセルファイル」が放り込んであるフォルダに一緒に保存しておく


改めて集計ブックを開く
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim myPath as string
　dim myFile as string
　dim w as worksheet

　mypath = thisworkbook.path & "\"
　myfile = dir(mypath & "...続きを読む

他の回答も見る

Q複数の同じフォーマットのファイルを新しいブックで一つのシートにまとめる方法

仕事で、各部署から送られてきた、同じフォーマットのファイル（シート1にのみデータ有）が50個近くあります。
それを新しいブックで一つのシートにまとめなくてはいけません。
地道にコピペするのは時間がかかるのでマクロで処理を行いたいと思います。
マクロでの処理方法ご存知の方、処理方法の載っているサイトをご存知の方、もしくはマクロより簡単な方法がありましたら教えてください。

あと、逆に一つのシートをいくつかのファイルに振り分けていく方法もご存知でしたら教えて下さい。
よろしくお願いします。

Aベストアンサー

すみません。質問を勘違いしていました。
>新しいブックで一つのシートにまとめなくてはいけません
でしたね。
Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf
Sheets("Sheet1").Range("A1:J1000").Copy
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Workbooks(buf).Activate
Application.CutCopyMode = False
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub
で試してみてください。使い方などは
http://oshiete1.goo.ne.jp/qa4225063.html
を参照してみてください。同じ質問があったので気がつきました。

すみません。質問を勘違いしていました。
>新しいブックで一つのシートにまとめなくてはいけません
でしたね。
Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf
Sheets("Sheet1").Range("A1:J1000").Copy
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Workbooks(buf).Activate
Application.CutCop...続きを読む

他の回答も見る

QEXCELで複数のファイルから抽出

Excelのことで困っています。
何かいい方法があれば教えてください。

同じフォームのエクセルファイルが約1000ファイルあり、それぞれのファイルの例えば3～5行目だけを抽出し、別のの新しいファイルにどんどん貼り付けて3～5行目だけを集めたファイルを作りたいのですが、ファイルの数が多いので、全ファイルを開いてコピペする以外にマクロか何かを使って自動で抽出できるような方法がないかと考えております。
1000個のファイル名は今はばらばらですが、必要であれば0001.xls～1000.xlsなどに変更してもよいです。

どうぞよろしくお願いします。

Aベストアンサー

抽出先のブックを同じフォルダに作成し、Alt+F11でVBAの画面を開き、左側のツリーからブック名を選択し、右クリックから「挿入」＞「標準モジュール」を選択して、右の画面に以下のマクロをコピーして貼り付けてください。

Sub ファイルから抽出()
　Dim FName As String
　Dim Folder As String
　Dim WB As Workbook
　Dim i As Integer, j As Integer
　Application.ScreenUpdating = False
　Folder = ThisWorkbook.Path & "\"
　i = 1: j = 1
　Worksheets(1).Cells.ClearContents
　FName = Dir(Folder & "*.xls")
　Do While FName <> ""
　　If FName <> ThisWorkbook.Name Then
　　　Workbooks.Open (Folder & FName)
　　　Workbooks(Workbooks.Count).Worksheets(1).Rows("3:5").Copy _
　　　ThisWorkbook.Worksheets(1).Cells(i, 1)
　　　Workbooks(Workbooks.Count).Close
　　　Application.StatusBar = j & "ファイル処理済み"
　　　i = i + 3: j = j + 1
　　End If
　　FName = Dir()
　Loop
　Application.StatusBar = ""
　Application.ScreenUpdating = True
　MsgBox ("完了しました")
End Sub

Alt+F11でExcelの画面に戻ってAlt+F8からマクロを実行してみてください。各ファイルの３行目～５行目がコピーされます。

高速化のために処理中は描画を止めているので、全ての処理が終わった後に画面は表示されます。1000個もファイルがあるとかなり時間がかかると思いますが、何個のファイルを処理したかは左下に表示するようにしているので、ある程度目安になると思います。

あと、フォルダ内のブックを開いてはコピーして閉じ、ということを繰り返しているので、実行中はタスクバーがちらちらしますが、気にしないでください。

抽出先のブックを同じフォルダに作成し、Alt+F11でVBAの画面を開き、左側のツリーからブック名を選択し、右クリックから「挿入」＞「標準モジュール」を選択して、右の画面に以下のマクロをコピーして貼り付けてください。

Sub ファイルから抽出()
　Dim FName As String
　Dim Folder As String
　Dim WB As Workbook
　Dim i As Integer, j As Integer
　Application.ScreenUpdating = False
　Folder = ThisWorkbook.Path & "\"
　i = 1: j = 1
　Worksheets(1).Cells.ClearContents
　FName = Dir...続きを読む

他の回答も見る

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(？)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか？
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします！

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

他の回答も見る

QＥｘｃｅｌの複数ファイルの内容を一つのファイルに集計する方法について教

Ｅｘｃｅｌの複数ファイルの内容を一つのファイルに集計する方法について教えてください。
各支店からの報告を集計したいのですが、同一フォームのファイル（約１００ファイル）で報告されるデータを一つのファイルに集計したいと思っています。
Ａ支店ファイルのｓｈｅｅｔ1、Ｂ支店ファイルのｓｈｅｅｔ1、・・・・を、合計ファイルのｓｈｅｅｔ1に集約したいのです。（フォームは同じで、内容は数値のみです。）
いい方法がある方、お教えください。

Aベストアンサー

フォルダー内の全エクセルファイルのデータを１シートにまとめるVBAのコードはWeb検索すれば、種々みつかります。下記はコードの若干の解説もあって良いと思います。
http://hpcgi1.nifty.com/kenzo30/b_cbbs/cbbs.cgi?mode=al2&namber=39812&no=0&P=R&KLOG=266
問題は、「同一フォーム」の内容ですね。
データ中に各支店名が含まれていなければ、抽出時に付与しないと訳が分からなくなるし、
変に凝った様式だと単純にコピーするだけではうまくいかないし。

他の回答も見る

Qフォルダ内の全てのBookに同じ処理を繰り返す

フォルダ内にエクセルファイルが約3,000個あります。
この全てのBookに同じ処理をしたいのですが、マクロで繰り返す方法がわからないので教えて下さい。
処理をする内容は簡単なもので、マクロで作りました。

・　各Bookには1つのシートしか存在せず、シート名は重要ではないので全て「Sheet1」になっています。
・　各Bookのデータの配置や表形式は同じです。
・　レコードの行数がBookによって異なります。

処理の内容をマクロで作るところまではできましたが、知識がないためタイムアウトです。

ご教示宜しくお願い致します。

Aベストアンサー

だいたいこんな流れで。

sub macro1()
　dim myPath as string
　dim myFile as string

　mypath = "C:\test\"

’指定フォルダのブックを順繰り拾う
　myfile = dir(mypath & "*.xls*")
　do until myfile = ""

　’ブックを開いて処理を行い保存して閉じる
　　workbooks.open mypath & myfile
　　activesheet.range("A1") = "DONE"
　　activeworkbook.close true

　　myfile = dir()
　loop
end sub


必要に応じて
・画面の表示を抑制する
・再計算を手動にする
といった手管を追加して高速化を図ります。

他の回答も見る

Q複数エクセルから特定シートの特定行だけを別シートに抽出するマクロ

エクセルブックが160ほどあります。
それらは全て同じ作りで、シートが2つづつ存在しています。
その2シート目（シート名”集約”シート）にある特定のセル（Ａ2からＴ2）だけを
別のエクセルに集めて一覧にしたいです。

色々とやってみてネット検索もしてみたのですが、うまくいかないので
どなたか教えていただけませんでしょうか。

Aベストアンサー

こんな感じで、どうでしょう。
MyPathで指定したフォルダ内の .xlsx ファイルを対象に一覧化します。
一覧は、A列にファイル名、B列以降に各ブック中の”集約”シートのA2～T2が表示されます。
ただし、”集約”シートが無い場合は、ちょっとおかしな動作をします。おかしな動作については、お楽しみ！！（元のファイルが壊れることは無いので、安心して実行してみて下さい）

Sub sample()
Dim MyPath As String
Dim MyFile As String
Dim I As Long
MyPath = "C:\教えてGoo\"
MyFile = "*.xlsx"
MyFile = Dir(MyPath & MyFile)
Do While MyFile <> ""
I = I + 1
Cells(I, "A") = MyFile
Range(Cells(I, "B"), Cells(I, "U")).Formula = "='" & MyPath & "[" & MyFile & "]Sheet1'!A2"
MyFile = Dir
Loop
End Sub

こんな感じで、どうでしょう。
MyPathで指定したフォルダ内の .xlsx ファイルを対象に一覧化します。
一覧は、A列にファイル名、B列以降に各ブック中の”集約”シートのA2～T2が表示されます。
ただし、”集約”シートが無い場合は、ちょっとおかしな動作をします。おかしな動作については、お楽しみ！！（元のファイルが壊れることは無いので、安心して実行してみて下さい）

Sub sample()
Dim MyPath As String
Dim MyFile As String
Dim I As Long
MyPath = "C:\教えてGoo\"
MyFile = "*.xlsx"...続きを読む

他の回答も見る

Qエクセルで、条件に一致した行を別のセルに抜き出す方法

エクセルで、指定した条件に一致するセルを含む行をすべて抜き出す方法が知りたいです。

たとえば、

<A列>　<B列>　<C列>
7/1　りんご　100円
7/2　ぶどう　200円
7/2　すいか　300円
7/3　みかん　100円

このような表があって、100円を含む行をそのままの形で、
別のセル（同じシート内）に抜き出したいのですが。

7/1　りんご　100円
7/3　みかん　100円

抽出するだけならオートフィルターでもできますが、
抽出結果を自動的に、別の場所に、常に表示させておきたいのです。

初歩的な質問だと思いますが、検索しても分からなかったので、よろしくお願いします。

Aベストアンサー

同じ質問が結構よく出てますが、そんなに初歩的でもありません
別シートのA1セルに「100円」と入力し、そのシートの任意のセルに以下の式を貼り付けて下さい。後は、下方向、右方向にコピー。
日付のセル書式は「日付」形式に再設定してください

=IF(COUNTIF(Sheet1!$C:$C,$A$1)>=ROW(A1),INDEX(Sheet1!A:A,LARGE(INDEX((Sheet1!$C$1:$C$500=$A$1)*ROW(Sheet1!$C$1:$C$500),),COUNTIF(Sheet1!$C:$C,$A$1)-ROW(A1)+1)),"")

データ範囲は５００行までとしていますが、必要に応じて変更して下さい

他の回答も見る
ページトップページトップ

Q質問する（無料）

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報