人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

出来ればエクセルだけで完結させたいのですが、例えば100個のエクセルファイルの A1セルに入っている値(情報)を一気に抜き出し101目(べつに何個目でもいいですが)のエクセルに抜き出した値(情報)を表示させたいです。 アクセスでもいいですが、一番簡単な方法で抜き出す方法を教えてください。


●質問者: miyako333
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● degucho
●100ポイント ベストアンサー

VBAマクロを記述したブックと同じフォルダ内にあるブックのA1セルの内容を
新規シートに転記するマクロを作成してみました


Public Sub ReadAllA1()

  'このフォルダ内のファイルを処理(今回はマクロ配置ブックと同じ場所とする)
 Dim baseDir As String
 baseDir = ThisWorkbook.Path + "\"
 
  'このパターンでxlsxもヒットする
 Dim pattern As String
 pattern = baseDir + "*.xls"
 
 Dim fileName As String
 fileName = Dir(pattern)
 
 Dim row As Integer
 row = 1
 
  '結果貼り付け用に新規シート作成
 Dim mySheet As Worksheet
 Set mySheet = Worksheets.Add
 
 Do While (fileName <> "")
  '自分自身以外のファイルの場合
 If (fileName <> ThisWorkbook.Name) Then
 
  'ブックを開いてA1を取得
 Dim wkb As Workbook
 Set wkb = Workbooks.Open(baseDir + fileName)
 Dim wks As Worksheet
 Set wks = wkb.Worksheets(1)
 Dim value As String
 value = wks.Range("A1").value
 
  '結果シートのA列にファイル名、B列にA1セルの値を転記
 mySheet.Cells(row, 1) = fileName
 mySheet.Cells(row, 2) = value
 row = row + 1
 
 Debug.Print value
 Set wks = Nothing
 wkb.Close
 Set wkb = Nothing
 
 
 End If
 fileName = Dir()
 Loop

 mySheet.Cells.EntireColumn.AutoFit
 Set mySheet = Nothing
 

End Sub


miyako333さんのコメント
ありがとうございます。 追加ですがこれに 例えば B1,C1,D1セルと対象を増やす場合は "A1" のところをどう変えればいいでしょうか。またほかに書き換えるところはありますか?

deguchoさんのコメント
改造すればいかようにもなると思いますが 範囲が広い場合、Range("A1:D1")などとして転記したほうがいいかもしれません。 http://officetanaka.net/excel/vba/cell/cell09.htm あと、Debug.Printは削除忘れのデバッグコードなので不要です。

miyako333さんのコメント
現実的には、例えば A1、C3、F4、 G1、H1,I1 の値を 抜き出して 今回教えてもらったみたいに A列に ファイル名 B列に A1 C列にC3、D列にF4、 E列にG1、F列にH1、G列にI1セルの値を つらつらと表示させたいです。 これだとどう書けばいいでしょうか。 マクロが苦手ですいません。 ぜひ教えて助けてください。 よろしくお願いします。

deguchoさんのコメント
直してみました。 苦手なのにVBAはOKですとか 質問に具体例を書かないのはダメですよ >|VB| Public Sub ReadAll() 'このフォルダ内のファイルを処理(今回はマクロ配置ブックと同じ場所とする) Dim baseDir As String baseDir = ThisWorkbook.Path + "\" 'このパターンでxlsxもヒットする Dim pattern As String pattern = baseDir + "*.xls" Dim fileName As String fileName = Dir(pattern) Dim row As Integer row = 1 '結果貼り付け用に新規シート作成 Dim mySheet As Worksheet Set mySheet = Worksheets.Add Do While (fileName <> "") '自分自身以外のファイルの場合 If (fileName <> ThisWorkbook.Name) Then 'ブックを開いてA1を取得 Dim wkb As Workbook Set wkb = Workbooks.Open(baseDir + fileName) Dim wks As Worksheet Set wks = wkb.Worksheets(1) Dim valueA1 As String Dim valueC3 As String Dim valueF4 As String Dim valueG1 As String Dim valueH1 As String Dim valueI1 As String valueA1 = wks.Range("A1").value valueC3 = wks.Range("C3").value valueF4 = wks.Range("F4").value valueG1 = wks.Range("G1").value valueH1 = wks.Range("H1").value valueI1 = wks.Range("I1").value '結果シートのA列にファイル名、B列以降に取得した値を転記 mySheet.Cells(row, 1) = fileName mySheet.Cells(row, 2) = valueA1 mySheet.Cells(row, 3) = valueC3 mySheet.Cells(row, 4) = valueF4 mySheet.Cells(row, 5) = valueG1 mySheet.Cells(row, 6) = valueH1 mySheet.Cells(row, 7) = valueI1 row = row + 1 Set wks = Nothing wkb.Close Set wkb = Nothing End If fileName = Dir() Loop mySheet.Cells.EntireColumn.AutoFit Set mySheet = Nothing End Sub ||<
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ