[[20140713163524]]　『全ファイルに反映させる』（ニワ）　ページの最後に飛ぶ

『全ファイルに反映させる』（ニワ）

 同一フォルダに，Ａ，Ｂ，Ｃ　のファイルがあります。
 ここで，「任意の１つのファイル」を選択し
 　　Ａ１セルに　あ　
 　　Ｂ１セルに　い
 　　Ｃ１セルに　う
 と入力します。
 そして，これらの　あ，い，うのデータを，マクロを使って，残りの２つのファイルの
 Ａ１，Ｂ１，Ｃ１セルにも反映されるようにしたいのですが，できますか。

 たとえば，任意のファイルとして，Ｂファイルを選択し，ＢファイルのＡ１，Ｂ１，
 Ｃ１セルにデータを入力し，そのデータを残りのＡファイル，ＣファイルのＡ１，
 Ｂ１， Ｃ１セルに反映させる
 また，Ｃファイルを選択したら，同じようにＡ，ＢファイルのＡ１， Ｂ１，
 Ｃ１セルに反映させる

 というマクロを作りたいのですが。

 任意のファイルはどのファイルか決まっていないので，Ａ，Ｂ，Ｃ全ファイルに，
 同じマクロを設定するイメージなんですが。

 いかがでしょうか。

＜使用 Excel：unknown、使用 OS：unknown ＞

 >＜ 使用 Excel：unknown、使用 OS：unknown ＞

 大事な情報ですが、分かりませんか？
（カリーニン） 2014/07/13(日) 17:00

 エクセル2010   ウィンドウズ7   です。

（ニワ） 2014/07/13(日) 17:59

 >「任意の１つのファイル」を選択し

 ファイル選択はどのようにして行うのでしょう？

 > 任意のファイルはどのファイルか決まっていないので，Ａ，Ｂ，Ｃ全ファイルに，
 > 同じマクロを設定するイメージなんですが。

 マクロブックから3つのファイルを制御、ではだめですか？
 3つのブックすべてにマクロを記述しておく必要はないように思えるのですが。
（カリーニン） 2014/07/13(日) 18:58

 ファイルの選択は、任意で規則性はありません。
 任意のファイルを開いて、データを入力して、
 開いているファイル上でマクロを実行して、他のファイルに反映される
 というふうにしたいのですが。

（ニワ） 2014/07/13(日) 20:23

 >任意のファイルを開いて、データを入力して、
 >開いているファイル上でマクロを実行して、他のファイルに反映される

 マクロブックから開いているブックを取得して制御できますが、やはりデータブック
 にマクロを記述しておくのでしょうか？

 同じコードを複数のブックに記述しておく必要性を感じません。
（カリーニン） 2014/07/13(日) 20:34

 "C:\test"の中に
 aaa.xlsx
 bbb.xlsx
 ccc.xlsx
 という3つのブックがあり、そのなかの一つのブックを
 開いて編集している、との仮定です。

 開いているブックのSheet(1)の"A1"、"B1"、"C1"のデータを
 他のブックの同じセルに転記します。

 このマクロは3つのブック以外のマクロブックの記述して実行
 します。

 Sub test()
  Dim fol As String
  Dim wbAmei As String
  Dim wbBmei As String
  Dim wbCmei As String
  Dim wbdic As Object
  Dim wb As Workbook
  Dim mywb As Workbook
  Dim newwb As Workbook
  Dim RngA As Range
  Dim RngB As Range
  Dim RngC As Range
  Dim flg As Boolean
  Dim wbkys As Variant
  Dim wbky As Variant
   fol = "C:\test"
   wbAmei = "aaa.xlsx"
   wbBmei = "bbb.xlsx"
   wbCmei = "ccc.xlsx"
   Set wbdic = CreateObject("Scripting.Dictionary")
   wbdic.Add wbAmei, fol & "\" & wbAmei
   wbdic.Add wbBmei, fol & "\" & wbBmei
   wbdic.Add wbCmei, fol & "\" & wbCmei
   flg = False
   For Each wb In Workbooks
    If wbdic.exists(wb.Name) Then
       flg = True
       Set mywb = wb
       wbdic.Remove (wb.Name)
    End If
   Next wb
   If flg = True Then
      Set RngA = mywb.Worksheets(1).Range("A1")
      Set RngB = mywb.Worksheets(1).Range("B1")
      Set RngC = mywb.Worksheets(1).Range("C1")
      wbkys = wbdic.keys
      For Each wbky In wbkys
       Set newwb = Workbooks.Open(wbdic(wbky))
       newwb.Worksheets(1).Range(RngA.Address(0, 0)).Value = RngA.Value
       newwb.Worksheets(1).Range(RngB.Address(0, 0)).Value = RngB.Value
       newwb.Worksheets(1).Range(RngC.Address(0, 0)).Value = RngC.Value
       newwb.Save
       newwb.Close
       Set newwb = Nothing
      Next wbky
   End If
   wbdic.RemoveAll
   Set wbdic = Nothing
   Set mywb = Nothing
 End Sub
（カリーニン） 2014/07/13(日) 21:36

 一部修正

   If wbdic.exists(wb.Name) Then

↓

   If wbdic.exists(wb.Name) And wb.Path = fol Then
（カリーニン） 2014/07/14(月) 09:27

コメント返信：

[ 一覧(最新更新順) ]

[[20140713163524]] 『全ファイルに反映させる』（ニワ） ページの最後に飛ぶ

[[20140713163524]]　『全ファイルに反映させる』（ニワ）　ページの最後に飛ぶ