マクロで関数を使う方法

質問

マクロ初心者です。
下記処理をスムーズに行う場合どのようにすればよいか
悩んでおります。的外れなことを質問しているかもしれませんが
わかる方がいましたら、教えてくださいお願いいたします。

工場のパーツの出荷に関してファイルを毎月まとめております。
毎月最新データーが他部署より送られてきて
そのファイルを私が、過去のファイルから一部データーを持ってきたりしております。
今回、下記の処理を簡単にさせたいのですが、マクロで出来る方法があれば教えてください。

下記2つのファイルのフォーマットは基本同じです。
装置番号の並びはその月その月で並びが違います。

【0904.xlsのファイル】
Ａ　　　　　　Ｂ　　　　　Ｃ　　　　　Ｄ　　　　Ｅ
装置番号　　商品　売上合計　コメント　担当
　a1　　　　P8　　13,523　　　***　　　●　
　B1　　　　P8　　38,523　　　+++　　　■
　a２　　　P１０　23,523　　　Ccc　　　△

他部署より送付された今月売上分（0905.xls）の
装置情報を0904ファイルを元にD・E項目をVLOOKで入力しています。

【0905.xlsのファイル】
Ａ　　　　　　Ｂ　　　　　Ｃ　　　　　Ｄ　　　　Ｅ
装置番号　　商品　売上合計　コメント　担当
　B1　　　　P8　　78,523　
　a1　　　　P8　　63,523　　　　　
　a２　　　P１０　53,523　

ここでは3行しかありませんが実際は2000行位あります。
また、VLOOKする項目も実際は10箇所ほどあります。
毎回前月のファイルを元にひとつひとつ関数でデーターを入力しております。
簡単に表示する方法がありましたらマクロでなくても教えてください。
お願いいたします。

回答No.3

n-jun · ベストアンサー

n-junです。

例えば0904.xlsがＡ列～Ｎ列までが検索範囲とした場合、

＞Set　rng1　=　.Range("A2"　,.Cells(.Rows.Count　,1).End(-4162)).Resize(,5)
を
Set　rng1　=　.Range("A2"　,.Cells(.Rows.Count　,1).End(-4162)).Resize(,14)
とする。

Resize(,5)　はＡ列を１としてどの位広げるかですから、Ｎ列であれば１４なので、
Resize(,14)　です。

0905.xls　の方は

With　.Offset(　,3)
⇒Ａ列からいくつ右に移動するか（Ｅ列なら３つ）

　　　.Formula　=　　"=VLOOKUP(A2,["　&　wb1.Name　&　"]"　&　wb1.Worksheets(1).Name　&　"!"　&　rng1.Address　&　",4,0)"
⇒４は0904.xlsの列数を差してます。

　　　.Value　=　.Value
End　With

これらをループ処理で行なえば、

For i = 1 To 11
　　　　With .Offset( ,i + 2)
　　　　　　　　.Formula = "=VLOOKUP(A2,[" & wb1.Name & "]" & wb1.Worksheets(1).Name & "!" & rng1.Address & "," & i + 3 & ",0)"
　　　　　　　　.Value = .Value
　　　　End With
Next

回答No.2

n-jun

n-junです。

＃１のコードをメモ帳などで一度テキストファイル（てすと.txt）に貼付けます。
保存した後でファイルの名前変更で拡張子”txt”を”vbs”とします。

そのアイコンをデスクトップに準備して下さい。

次に0904.xls 0905.xlsのファイルをデスクトップにコピペして下さい。
２つのファイルを選択して、同時にドラッグし（てすと.vbs）のアイコンの上に
重ねて下さい。

暫くすると”作業が終わりました”と表示されますので、0905.xlsのファイルを
開いてみて下さい。
変更されているはずです。

ただしこれは提示された情報のみで検証し作成されています。
・0904,0905とは固定されないため、違うBookの準備が必要だった。
・データの転記は２列になっている。（それ以外はどこなのか不明）
・作業性からファイルをドラッグさせて処理を行えるようにしてみた。
と言った所です。

ご参考になれば幸いです。（Windows　XPにて検証）

お礼

こんにちは。

回答ありがとうございます。
早速ためしでしてみました。
問題なく動くことができました。

この方法で自分でアレンジして組み替えていこうかと思います。
（転記数を増やした場合・・・できるか不安ですが）

ありがとうございました。

回答No.1

n-jun

取り敢えず提示されている範囲をＶＢＳで。

　Dim　FSO　,　Fname2
　Dim　xlApp
　Dim　wb1　,　wb2
　Dim　rng1　
　Dim　v　,　w

　Set　Fname　=　WScript.Arguments
　If　Fname.Count　=　0　Or　Fname.Count　<>　2　Then
　　　　WScript.Echo　"Excelファイルをドラッグして下さい。"　&　vbCrLf　&　_
　　　　　　　　　　　　　　　　　"または２つのExcelファイルをドラッグして下さい。"
　　　　WScript.Quit
　End　If

　For　i　=　0　To　1
　　　　　Ext　=　LCase(Right(Fname(i),　4))
　　　　　If　Not　(Ext　=　".xls")　Then
　　　　　　　　WScript.Echo　"このファイルはExcelファイル(.xls)ではありません。"
　　　　　　　　WScript.Quit
　　　　　End　If
　Next

　Set　xlApp　=　CreateObject("Excel.Application")
　　　　　xlApp.Visible　=　False
　　　　　xlApp.WorkBooks.Open(Fname(0))
　　　　　xlApp.WorkBooks.Open(Fname(1))

　　　　　v　=　Split(Fname(0),"\")　:　w　=　Split(Fname(1),"\")

　If　v(Ubound(v))　<　w(Ubound(w))　Then
　　　　Set　wb1　=　xlApp.WorkBooks(v(Ubound(v)))
　　　　Set　wb2　=　xlApp.WorkBooks(w(Ubound(w)))
　Else
　　　　Set　wb1　=　xlApp.WorkBooks(w(Ubound(w)))
　　　　Set　wb2　=　xlApp.WorkBooks(v(Ubound(v)))
　End　If

　With　wb1.worksheets(1)
　　　　　　Set　rng1　=　.Range("A2"　,.Cells(.Rows.Count　,1).End(-4162)).Resize(,5)
　End　With

　With　wb2.Worksheets(1)
　　　　　　With　.Range("A2"　,.Cells(.Rows.Count　,　1).End(-4162))
　　　　　　　　　　　With　.Offset(　,3)
　　　　　　　　　　　　　　　　.Formula　=　　"=VLOOKUP(A2,["　&　wb1.Name　&　"]"　&　wb1.Worksheets(1).Name　&　"!"　&　rng1.Address　&　",4,0)"
　　　　　　　　　　　　　　　　.Value　=　.Value
　　　　　　　　　　　End　With

　　　　　　　　　　　With　.Offset(　,4)
　　　　　　　　　　　　　　　　.Formula　=　　"=VLOOKUP(A2,["　&　wb1.Name　&　"]"　&　wb1.Worksheets(1).Name　&　"!"　&　rng1.Address　&　",5,0)"
　　　　　　　　　　　　　　　　.Value　=　.Value
　　　　　　　　　　　End　With
　　　　　End　With
　End　With

　wb1.Close　False
　wb2.Close　True
　xlApp.Quit

　WScript.Echo　"作業は終了しました"

　Set　xlApp　=　Nothing
　Set　wb1　=　Nothing
　Set　wb2　=　Nothing
　Set　rng1　=　Nothing