他ファイル参照マクロの修正方法
- check.xlsmファイルのマクロで抽出するファイルのチェックボックスの名前が変更された場合に、データを参照する方法について相談です。
- 現在のマクロでは特定のチェックボックスの名前を指定して抽出していますが、チェックボックスの名前が変わってもデータを参照できるように修正したいです。
- 修正方法について、マクロ初心者なので分かりやすく教えていただきたいです。
- ベストアンサー
他ファイルを参照するマクロ
excel2010 check.xlsmというファイルにマクロが存在します。 このファイルは、c:\workフォルダに登録されている***A2***.xlsmというファイルからデータを抽出するマクロになっています。 ***A2***.xlsmの***は、ファイル名の中にA2という文字があり、 色々とファイル名が変化するということを意味しています。 ***A2***.xlsmのファイルにはチェックボックスがあり、名前を付けています。 _ch227173520_0002 が一例です。 check.xlsmのファイルで、いろんなファイルのチェックボックス状態を収集するマクロが 下記です。 Dim mypath As String Dim myFile As String '検索フォルダ mypath = "C:\work\" '検索ファイル名 myFile = Dir(mypath & "*A2*.xlsm") 'F列に抽出した結果を記載 Workbooks.Open mypath & myFile With Workbooks("check.xlsm").Worksheets("Sheet1").Range("F65536").End(xlUp) .Offset(0, 0).Value = myFile 'ファイル名 .Offset(63, 0).Value = Range("_ch227173520_0002").Value End With Workbooks(myFile).Close savechanges:=False このマクロでcheck.xlsmファイルのF64セルに、 100A2001.xlsmファイルのチェックボックス_ch227173520_0002の内容を抽出しています。 しかしながら、***A2***.xlsmファイルに仕様変更があり、チェックボックスの名前が変わってしまいました。 _ch227173520_0002 → _ch3131000 の様にです。 これだと、データを参照できないので実行エラーが出てしまいます。 なので、 .Offset(63, 0).Value = Range("_ch227173520_0002").Value → .Offset(63, 0).Value = Range("_ch3131000").Value とマクロを修正すれば、データは参照可能になりますが、 どのA2ファイルがどちらのチェックボックスなのかは、分かりません。 エラーが出たらcheck.xlsmのファイルを変えてやり直すというのは不便です。 チェックボックスの名前がどちらであっても .Offset(63, 0).Valueにデータを持ってくる様にしたいのですが、 どの様にしたらよいでしょうか? マクロ初心者です。 学習マクロくらいしかできないので、ベタで教えていただきたく、 よろしくお願いします。
- 3620313
- お礼率84% (217/257)
- Excel(エクセル)
- 回答数1
- ありがとう数2
- みんなの回答 (1)
- 専門家の回答
質問者が選んだベストアンサー
以下のようにします。 'F列に抽出した結果を記載 Workbooks.Open mypath & myFile With Workbooks("check.xlsm").Worksheets("Sheet1").Range("F65536").End(xlUp) .Offset(0, 0).Value = myFile 'ファイル名 'ここ以降でエラーが起きたらnetgetラベルへ飛ぶ on error goto newget '旧仕様で試す .Offset(63, 0).Value = Range("_ch227173520_0002").Value 'エラー処理を元に戻す on error goto 0 End With (略) 'Sub内での処理が終わったら:netget以降を実行してしまわないようにSubから抜ける Exit Sub 'エラーが起きた時に飛んでくる場所 :netget '新しい仕様で試す .Offset(63, 0).Value = Range("_ch3131000").Value 'エラーが起きた行の次から再開 Resume Next End Sub
関連するQ&A
- 複数ファイルのA1だけを抽出して別ファイルにしたい
すみませんが、教えてください。 特定のフォルダ内に入っているcsvのA1列目のみ抽出して別ファイルにしたく、検索したところ 同じように困っていた方がいたようで、参考にさせていただいたのですが、 以下を実行しても インデックスが有効範囲にありませんと出ます。 各csvファイルのシート名は 1000近くあるファイル全て違い、別々の名前(コード00-000とか)になっています。 (エクセルで開いたとき) お手数ですが、教えていただきたくお願いいたします。 参考にしたマクロです。 Sub macro1() Dim myPath As String Dim myFile As String myPath = "ファイルの場所\" myFile = Dir(myPath & "*.xls") Do Until myFile = "" Workbooks.Open myPath & myFile With Workbooks("集約.xls").Worksheets("Sheet1").Range("A65536").End(xlUp) .Offset(1, 0).Value = myFile .Offset(1, 1).Value = Workbooks(myFile).Worksheets("概要").Range("C3").Value End With Workbooks(myFile).Close savechanges:=False myFile = Dir() Loop End Sub 宜しくお願いいたします。
- 締切済み
- SE・インフラ・Webエンジニア
- 複数のエクセルデータ上特定位置の値を一つのセルに2
前回の質問「複数のエクセルデータ上特定位置の値を一つのセルに」に対し、ベストアンサーを教えていただきました。その質問とご回答のポイントは次の通りです。 質問: 大量の同じフォーマットのエクセルファイル(Book1,Book2...)があり、それぞれのBookファイルの「NO.」シートのD6セルには番号が入っています。それぞれファイルでSheet1の特定のセル(例えばB4セル)の値を「データ」ファイルのSeet1にまとめたいです。「データ」ファイルのA列には「NO.」が入力されているので、Bookファイルの値はそれぞれ対応する番号の右側3番目のセルに移したいです。 ご回答: sub macro1() dim myPath as string dim myFile as string dim myNo as variant dim myRng as range on error resume next application.screenupdating = false mypath = "c:\test\" ’book1,2,3…の保存場所を指定する事 myfile = dir(mypath & "*.xlsx") ’拡張子を正しく指定すること do until myfile = "" workbooks.open mypath & myfile myno = workbooks(myfile).worksheets("No.").range("D6").value set myrng = thisworkbook.worksheets("Sheet1").range("A:A").find(what:=myno, lookin:=xlvalues, lookat:=xlwhole) myrng.offset(0, 3).value = workbooks(myfile).worksheets("Sheet1").range("B4").value workbooks(myfile).close savechanges:=false myfile = dir() loop application.screenupdating = true end sub 現在Excel2007を使っており、Bookファイルが全部(.xlsx)の状態では問題なく使えましたが、ファイルが97-2003の(.xls)バージョンになると、マクロを実行したときに次のメッセージが出ます。「データ.xlsmは既に開いています。2重に開くと、これまでの変更内容は破棄されます。データ.xlsmを開きますか?」 もちろんご回答の中の「myfile = dir(mypath & "*.xlsx") ’拡張子を正しく指定すること」は("*.xls")に変更されている状態です。 何が問題なのか全く分からず、困っています。どなたか教えていただけないでしょうか? よろしくお願い致します。
- ベストアンサー
- Excel(エクセル)
- 複数のエクセルファイルとシートからデータ抽出したい
以前に http://soudan1.biglobe.ne.jp/qa8369459.html でやられている内容なのですが、私の場合はシートすべての[i4」のセル値を一覧でひっぱりたいです。 keithinさんご回答の 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 ↑をRange("i4").Value end with next workbooks(myfile).close false end if myfile = dir() loop application.screenupdating = true end sub にて実施しましたが、ファイル名・シート名は正確に抽出するものの 参照したい「i4」のデータが先頭のシートのi4だけを拾ってしまいます 1.xls、2.xls、3xlsがありそれぞれ名前がばらばらなシート「あ」、「い」、「う」の3つがある。2.xlsには「え」、「お」、「か」のしーとがあると仮定、マクロを実行すると、一覧のエクセルに 1、xls あ あのシートi4の値 1、xls い あのシートi4の値 1、xls う あのシートi4の値 2.xls え えのシートi4の値 2.xls お えのシートi4の値 2.xls か えのシートi4の値 子のようなか形で出力されます い のところには いのシートのi4が、う のところには うのシートのi4が、 抽出されるには構文をどう買えればよいのでしょうか
- ベストアンサー
- Visual Basic
- Excelのマクロで同じ処理を実行
Excelのマクロについてです。 この度、フォルダ内にあるデータから傾きを抽出して、 データシートにまとめる作業を求められています。 一度ずつ開いて行うのが大変なので、マクロを用いようと思っています。 Sub マクロループ() Dim myPath As String Dim myFile As String myPath = "C:\test\" myFile = Dir(myPath & "*.CSV*") Do Until myFile = "" Workbooks.Open myPath & myFile ( ActiveWindow.ScrollRow = 2 ActiveWindow.ScrollRow = 3 ~ ~ ActiveSheet.Shapes("グラフ 1").IncrementLeft -125.25 ActiveSheet.Shapes("グラフ 1").IncrementTop 21.75 Application.CommandBars("Format Object").Visible = False ) ActiveWorkbook.Close True myFile = Dir() Loop End Sub ~の部分に省略した処理が入ります。 これでエラーなどは起きないのですが、開いて閉じるだけになってしまっています。 ()で括られた部分だけで実行すると、そのファイルで傾きを表示してくれます。 これを全ファイルでやりたいのですが、お力添えをお願いします。 また、それぞれで得られた傾きをデータシートに自動で入力することなどができればそれも教えていただければ幸いです。 どうかよろしくお願いします。
- 締切済み
- Visual Basic
- エクセルVBAで他のbookのセルcellsで参照
エクセルVBAで他のbookのセルの値(一定の範囲)を参照したいのですが、変数を使いたいため、cellsを使用したいのですがうまくいきません。方法はないでしょうか。 下記に例を示します。 rangeを使用すればすべてok((2)(5))(この場合はset文を使用しなくてもok(5))。同じbookならcells使用ok(4)。 他のbookをcells文使用する方法はないでしょうか(もちろんできれば、Thisbookの方もcellsを使用したい)。 よろしくお願いします。 sub test() Dim ThisBook As Workbook Dim Workbook2 As Workbook 'マクロを実行しているワークブック Set ThisBook = ThisWorkbook '他のワークブック Set Workbook2 = Workbooks("test11.xlsx") ' 'ThisBook.Worksheets(1).Range("A1:B2").Value = Workbook2.Worksheets(1).Range(Cells(1, 1), Cells(2, 2)).Value '(1)だめ 'ThisBook.Worksheets(1).Range("A1:B2").Value = Workbook2.Worksheets(1).Range("a1:b2").Value '(2) OK 'Workbooks("test1.xlsm").Worksheets(1).Range("A1:B2").Value = Workbooks("test11.xlsx").Worksheets(1).Range(Cells(1, 1), Cells(2, 2)).Value '(3) だめ 'Workbooks("test1.xlsm").Worksheets(1).Range("A1:B2").Value = Workbooks("test1.xlsm").Worksheets(1).Range(Cells(3, 3), Cells(4, 4)).Value '(4)だめ 'Workbooks("test1.xlsm").Worksheets(1).Range("A1:ii8000").Value = Workbooks("test11.xlsx").Worksheets(1).Range("a1:ii8000").Value '(5) ok End Sub
- 締切済み
- オフィス系ソフト
- マクロ処理後のファイル名変更について
マクロでいくつかの処理を行った後、もとのファイル名に 「済+ファイル名」としてファイル名を変更して終了をしたいのですが、 どのようにすればできるのかわかりません。 どなたか教えていただけますか? イメージ) 処理前のファイル名:サラダ.xls、お肉.xls・・・ 処理後のファイル名:済サラダ.xls、済お肉.xls・・・ Dim myPath As String Dim myFile As String Dim w As Workbook Dim s As Worksheet myPath = ThisWorkbook.Path & "\" myFile = Dir(myPath & "*.xls") Do Until myFile = "" If myFile <> ThisWorkbook.Name Then Set w = Workbooks.Open(myPath & myFile) For Each s In w.Worksheets s.Range・・・・・ ・・・・・・・・ ・・・・・・・・ Next w.Close savechanges:=True End If myFile = Dir() Loop MsgBox "完了しました。" End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL マクロ につきまして
お世話になっております。 以前、同様の質問をさせていただきまして、 その拡張バージョンをつくりたいと考えております。 Sub macro1() Dim myPath As String Dim myFile As String Dim c As Long Dim LastRowr As Long Application.ScreenUpdating = False myPath = ThisWorkbook.Path & "\" myFile = Dir(myPath & "*.xls") c = 6 Do Until myFile = "" If myFile <> ThisWorkbook.Name Then Workbooks.Open Filename:=myPath & myFile lastrow = Worksheets("特定のシート").Range("A65536").Row ThisWorkbook.Worksheets(2).Cells(1, c).Resize(lastrow, 1).Value = Worksheets("特定のシート").Range("H1").Resize(lastrow, 1).Value Workbooks(myFile).Close False c = c + 1 End If myFile = Dir() Loop Application.ScreenUpdating = True On Error Resume Next ActiveSheet.Name = Format(Date, "mmdd") On Error GoTo 0 End Sub こちらは"特定のシート"の特定の列(H)のみをひたすらフォーマットに 貼り付けていくものですが、コピペしたい列が増えた場合(数は一定ではない) のバージョンができればと思っております。 正直まったくわかりません。 1)データが何列あるかは不定 2)行1~3には自動的に何らかのデータが振られてしまっており(連番等) データの終わりとして使えそうなのは、行4に「0」が入っていること (但し0は非表示にしております) "特定のシート"名・データがH列から始まる等は変わりません。 現状の記述を改修、もしくは全とっかえでも構いません。 なにとぞよろしくお願い致します。
- ベストアンサー
- Excel(エクセル)
- 一部マクロを変更したいので教えてください。
現在、下記のようなマクロを使用しています。 Sub sample() Dim myFile As String, myPath As String, i As Long Application.ScreenUpdating = False myPath = InputBox("フルパスでフォルダーを指定") myFile = Dir(myPath & "\*.xls", vbNormal) Do Workbooks.Open myPath & "\" & myFile For i = 1 To ActiveWorkbook.Sheets.Count If WorksheetFunction.CountA(Sheets(i).Range("B7:B11")) = 0 Then Sheets(i).Range("B7") = "*" End If Next ActiveWorkbook.Close True myFile = Dir() Loop While myFile <> "" Application.ScreenUpdating = True MsgBox "完了 !!" End Sub 上から4行目のmyPath = InputBox("フルパスでフォルダーを指定")を パスを入力するマクロではなくてもっと簡単にフォルダを選択するマクロに変更したいのですが どうすればいいですか?
- ベストアンサー
- オフィス系ソフト
- 別シートから検索・抽出(VBA)
Private Sub Worksheet_Change(ByVal Target As Range) Dim ret If Target.Address = "$B$2" Then Set ret = Workbooks("抽出.xlsm").Sheets("抽出元").Range("A:A") _ .Find(ActiveSheet.Range("B2").Value) ActiveSheet.Range("C2").Value = ret.Offset(0, 5).Value ActiveSheet.Range("D2").Value = ret.Offset(0, 6).Value ActiveSheet.Range("E2").Value = ret.Offset(0, 7).Value ActiveSheet.Range("F2").Value = ret.Offset(0, 4).Value ActiveSheet.Range("G2").Value = ret.Offset(0, 2).Value ActiveSheet.Range("H2").Value = ret.Offset(0, 8).Value ActiveSheet.Range("I2").Value = ret.Offset(0, 9).Value ActiveSheet.Range("J2").Value = ret.Offset(0, 10).Value End If End Sub 上記のようなマクロで 選択したセルの値を検索(必ずB列) 選択セルと同じ行に抽出した各データを書き込み(選択セルがB5の場合 C5,D5,E5…に書き込む) ようにするにはどのように書き換えたらいいのでしょうか。 変数で行を取得して…など試したのですがどうもうまくいきません。 どなたかお願いします。 オートフィルタも考えたのですが諸事情で見出しを揃えることができない為諦めました。 現在はVLOOKUP関数で処理を行っていますが既に24000近いセルに式が入っており、データは重くなるし非効率的な気がします。
- ベストアンサー
- Visual Basic
- エクセル、マクロの事で・・・?(2)
昨日、質問した者です。 http://okwave.jp/qa/q7374907.html 以下のマクロを教えてもらいました。 昨日の質問では、エクセルのA列にフォルダ名、B列にファイル名、それぞれフォルダとtxtを出力するマクロを教えてもらいました。 そこでもう一つ質問があるのですが、C列の内容をテキストに出力する場合はどうすればいいのでしょうか? 度々の質問で申し訳ありませんが、教えていただけないでしょうか? よろしくお願いします。 sub macro1() dim myPath as string dim h as range on error resume next mypath = thisworkbook.path worksheets(1).select for each h in range("A1:A" & range("A65536").end(xlup).row) mkdir mypath & "\" & h.value open mypath & "\" & h.value & "\" & h.offset(0, 1).value & ".txt" for output as #1 close #1 next end sub
- ベストアンサー
- オフィス系ソフト
お礼
回答ありがとうございます。 助かりました(*^。^*) netgetとnewgetで名称が違っていたので、 newgetとしました。 'ここ以降でエラーが起きたらnetget→newgetラベルへ飛ぶ on error goto newget 'エラーが起きた時に飛んでくる場所 :netget → :newget