[[20070412184535]] 『ファイルの参照』(naoyan) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『ファイルの参照』(naoyan)

お世話になります。
エクセルでデータ処理をしているのですが、下記事項で悩んでいますのでご指導ください。

例えば、Book1.xlsファイルのA1セルにBook2.xls、A2セルにBook2.xlsのあるフォルダのパスとを入力してマクロを実行すると
Book2.xlsのB4セルからF4セルまでの数値をもってきて、Book1.xlsのA3からA7までに貼り付けるようなマクロはどのようにすれば良いですか。
初心者の為、マクロの記録でやったものをいじってみようとしているのですが、Book2.xlsの
あるフォルダの指定及びBook2.xlsの指定方法がわかりません。
どうぞ宜しくお願い致します。


いろいろやっていたら、ある程度できたのですが、
Book1.xlsファイルのA1セルに C:\仕事\個人用\横山\12月 A2セルに book2.xls と入力すれば
C:\仕事\個人用\横山\12月にあるbook2.xlsを開くマクロが分かりません。
宜しくお願いします。

 こうですか?
 シートの\ /の所を右クリックして→コードの表示で出た画面に↓をコピペ
 仕様としてA1セルに目的のBookまでのパス
 A2にブック名でブック名が変更されたらマクロが動きます。
 (力技)

 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim myFol As String, myXls As String
 If Target.Address <> "$A$2" Then Exit Sub
 myFol = Range("A1") & "\"
 myXls = Range("A2")
 Workbooks.Open myFol & myXls
 End Sub


 関数を埋めれば開かなくてもできますよ?
 (seiya)

有難うございます。試してみたら巧くいきました。
ただ、入力した時ではなくて、マクロの実行で操作を行いたいと思い、
そのままModuleに貼り付けると、コンパイルエラーでEnd Subが必要ですとなります。
なにか足りないのでしょうか。
また、関数をうめると開かなくてもできるとは、どうすればよいのですか?
宜しくお願い致します。

 投稿の際にはHNを記入してください。

 ='C:test\[Book2.xls]sheet1'!B4
 等とすれば開いてなくてもリンクできますよね?
 これを、VBAで書いてやればよいのです。
 または,ExecuteExcel4Macroでも抽出できますよ?
 (seiya)

 >コンパイルエラーでEnd Subが必要です
 ↑は多分
 Sub test()
    ・
    ・
 Private Sub Worksheet_Change(ByVal Target As Range)
    ・
    ・
 End Sub
 End Sub

 になってませんか?
 Sub test()
 に使うなら

 Dim myFol As String, myXls As String
 If Target.Address <> "$A$2" Then Exit Sub
 myFol = Range("A1") & "\"
 myXls = Range("A2")
 Workbooks.Open myFol & myXls

 中身のだけをコピペすれば使えますよ。
 (力技) 

(naoyan)です。馬鹿ですみません。

    Workbooks.OpenText Filename:= _
        "C:\横山\データ\MAN_0001.RND", StartRow:=1 _
        , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
        Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1))
    Range("G13:L13").Copy
    Windows("グラフ.xls").Activate
    Range("B13").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Windows("MAN_0001.RND").Activate
    Range("Y13:AN13").Copy
    Windows("グラフ.xls").Activate
    Range("B26").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Windows("MAN_0001.RND").Close
End Sub

これの "C:\横山\データ\MAN_0001.RND" の部分で

C:\横山\データをA2セルに、MAN_0001.RNDをA1セルに入力してマクロを実行すると
うえの作業が実行されるようにしたいのですが。
どのように変更すれば良いのですか?
宜しくお願い致します。


 filename:=Range("a2").Text & Range("a1").Text
 に変更すればいいんじゃないの?
 でも、これ本来の質問と全然関係ないんじゃないの?
 (seiya)

申し訳ありません。
確かに本来の質問とは、ずれたところを質問してます。
(力技)様へは失礼致しました。
(seiya)様のご回答で巧くいきました。

       :

       :

 Windows("MAN_0001.RND").Activate
    Range("Y13:AN13").Copy
    Windows("グラフ.xls").Activate
    Range("B26").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Windows("MAN_0001.RND").Close

の("MAN_0001.RND")の部分が反映されない為、半分しか処理できません。
この部分はどのように訂正すればよいのでしょうか。

本来の質問からはずれていましが、ご教授ください。


 Activate/Select はしない。

 Workbooks("MAN_001.RND").Sheets("シート名").Range("Y13:AN13").Copy
 Workbooks("グラフ.xls").Sheets("シート名").Range("b26").PasteSpecial Paste:=xlPasteValues, Transpose:=True

 では?
 (seiya)

説明不足で申し訳ありません。
上のマクロは、マクロの実行で作ったものなので、MAN_001.RNDとなっておりますが、
実際はB2のセルを参照したいのです。
B4にフォルダパス、B2にファイル名いれれば各セルの値を読み取って、データを抜き出す
という、マクロを作ろうと思いました。
(seiya)様の御指導で下記の様に出来ましたが、下の方のMAN_001.RNDもセルB2を参照するようにしたいのです。お手数をおかけしますが、どうぞご教授ください。

  Workbooks.OpenText Filename:= _
        Range("B4").Text & "\" & Range("B2").Text, StartRow:=1 _
        , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
        Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1))
    Range("G13:L13").Copy
    Windows("周波数分析グラフ.xls").Activate
    Range("B13").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Windows("MAN_0001.RND").Activate
    Range("Y13:AN13").Copy
    Windows("周波数分析グラフ.xls").Activate
    Range("B26").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Windows("MAN_0001.RND").Close
End Sub

(naoyan)


 それじゃ変数で参照させればよいでしょう。

 Dim wb As Workbook
 Set wb = Workbooks.OpenText FileName:=..........
 として
 wb.Sheets("シート名").Range("範囲").Copy
 ThisWorkbook.Sheets("シート名").Range("範囲").PasteSpecial ....
 では?
 (seiya)

申し訳ありません。
上の"MAN_0001.RND"の部分を、周波数分析グラフ.xlsのsheet1のB2セルを参照したいのですが、具体的にはどうすればよいのでしょうか?
おそらく、最適なご指導を頂いているとは思いますが、上のマクロをどのように変更すればよいのか分かりません。
度々申し訳ありませんが、宜しくお願い致します。

 その部分を Workbooks("周波数分析グラフ.xls").Sheets("Sheet1").Range("b2").Value
 に変えたいのですか?

 セルの値の取得はできますか?
 Workbooks("ブック名").Sheets("シート名").Range("範囲名").Value もしくは .Text
 (seiya)

Workbooks("周波数分析グラフ.xls").Sheets("Sheet1").Range("b2").Value.Activate
Range("Y13:AN13").Copy
ということでしょうか?
(naoyan)

 MAN_001.RND は WorkBook.OpenText で開きますよね?
 Workbooks.OpenText FileName:=......の部分に希望する値を代入するわけですね?
 Set wb = Workbooks.OpenText FileName:=....
 で 変数 wb はWorkbooks("MAN_001.RND")を参照するようになるのですが?
 お分かりになりますか?
 (seiya)

    Dim wb As Workbook             ←ここを変更
    Set wb = Workbooks.OpenText FileName:= _    ←ここを変更
        Range("B4").Text & "\" & Range("B2").Text, StartRow:=1 _
        , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
        Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1))
    Range("G13:L13").Copy
    Windows("周波数分析グラフ.xls").Activate
    Range("B13").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    wb.Sheets("sheet1").Range("Y13:AN13").Copy   ←ここを変更
    Windows("周波数分析グラフ.xls").Activate
    Range("B26").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True    
    wb.Close             ←ここを変更
End Sub
ということでしょうか?
上記で実行したところFilenameでコンパイルエラーとなります。
ご丁寧な説明を、理解できなく申し訳ありません。
(naoyan)

 Dim wb As Workbook
 With Workbook("周波数分析グラフ.xls").Sheets("Sheet1")
      Set wb = workbooks.OpenText Filename:=.Range("b4").Text & .Range("b2").Text,....
        ......
       .......
      wb.Sheets("sheet1").Range("G13:L13").Copy
      .Sheets("sheet1").Range("b26").PasteSpecial Paste:=xlValues, Transpose:=True
      wb.Close
 End With

 こんな感じでしょうか? 各"Sheet1"は適当ですので変更してください。
 (seiya)

 Sub データ読込()
'
' データ読込 Macro
      :
のSubは何か違う物に変えるのでしょうか。
度々恐縮です。
(naoyan)

(seiya)様のご指導で下記までたどり着けましたが、巧くいきません。
私の理解不足とは思いますが、間違いをご指摘ください。

Sub データ読込()

'
' データ読込 Macro
' マクロ記録日 : 2007/4/12 '
'

 Dim wb As Workbook
 With Workbook("周波数分析グラフ.xls").Sheets("Sheet1")
      Set wb = workbooks.OpenText Filename:=.Range("b4").Text & .Range("b2").Text, StartRow:=1 _
        , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
        Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1))
    Range("G13:L13").Copy
    Windows("周波数分析グラフ.xls").Activate
    Range("B13").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    wb.Sheets("sheet1").Range("Y13:AN13").Copy
      .Sheets("sheet1").Range("b26").PasteSpecial Paste:=xlValues, Transpose:=True
      wb.Close
 End With
 End Sub

(naoyan)


 HN変えて、新たにスレ立てるのは感心しませんね...
 他の方が回答してくれるでしょう.
 (seiya)

(seiya)様、大変申し訳ありません。
昨日は、何度もご指導いただき本当に感謝しております。
仕事の都合上、今日の午前中までに作成するよう言われておりましてあせっていました。
こちらの勝手な都合で皆様に失礼な行為をしてしまい、失礼致しました。
特に(seiya)様には、せっかくの好意を踏みにじることになり、気分を害されたことには反省しております。申し訳ありませんでした。

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.