ブック間でデータの移植をしたい（Excel2000）

質問

関数なら少しわかるけど，マクロはさっぱりなので質問します。

ブックが２つあります。
BOOK1はそれぞれシート名に個人名が入っていて，
１行目には科目名，A列には日付が入っています。
入力されているデータはその科目の点数が数値で入っています。

BOOK2は，ファイル名が日付（例：030115.xls）で１シートで構成されており，
ある日の試験の成績がA列に個人名，B列以降に科目毎の点数が入っています。
（シート名はsheet1のまま）

次から次へと提出されるBOOK2のデータを
BOOK1の個別シートに集めていきたいのですが...

関数でできればそれに越したことはありませんが，
マクロででもできれば嬉しいです。

急ぎなので勉強をしている時間がなく，助けて下さい！

わからないことがあればなるべく早く補足します。

回答No.3

nishi6 · ベストアンサー

参考にコードを書いて見ました。

試験の成績のBookのSheet1は

個人名　　英語　　数学　　国語　　理科
山田太郎　９０　　９１　　９２　　９３
木村花子　５１　　５２　　５３　　５４
佐藤一郎　７６　　７７　　７８　　７９
　：
のようになっているとします。科目数が『４』の例です。

個人単位のBookの初期状態はSheet1のみとします。
試験の成績Bookを読むたびに個人名のシートが無ければこの個人名のシートを自動的に追加していきます。

マクロを動かし、集計するファイル名を選択します。

Sheet名:山田太郎
　日付　　　英語　　数学　　国語　　理科
　2003/1/15　９０　　９１　　９２　　９３
　2003/1/25　＊＊　　＊＊　　＊＊　　＊＊
のように集計していきます。

個人単位のBookのSheet1のコードウインドウに貼り付けます。ご参考に。(当方、Excel97です)
↓
Sub Test()
　　Const KamokuSuu = 4 '試験の科目数 ***ここは例***
　　Dim myWB As Workbook '個人シートで編成されたBook
　　　　Set myWB = ThisWorkbook
　　Dim wbName As String '試験の成績のBook名
　　Dim tstWB As Workbook '試験の成績Book
　　Dim tstSht As Worksheet '試験の成績BookのSheet1
　　Dim strDay As String 'シート名から求めた日付(文字列)
　　Dim Hizuke As Date 'シート名から求めた日付

　　'開くBookを選択する
　　wbName = Application.GetOpenFilename()
　　If wbName <> "False" Then
　　　　Workbooks.Open FileName:=wbName
　　　　Set tstWB = ActiveWorkbook
　　　　Set tstSht = tstWB.Worksheets("Sheet1")
　　Else
　　　　Exit Sub
　　End If

　　'日付を求める
　　strDay = Left(tstWB.Name, 6)
　　Hizuke = DateSerial("20" & Left(strDay, 2), Mid(strDay, 3, 2), Right(strDay, 2))

　　'個人単位に処理する
　　Dim rw As Integer '行カウンタ
　　Dim Shimei As String '氏名
　　Dim ws As Worksheet '個人シートで編成されたBookのワークシート
　　Dim fndFlg As Boolean '個人名で検索したシートの有無
　　Dim wrtRow As Integer '書き込む行
　　Dim c As Integer '列カウンタ

　　myWB.Activate
　　For rw = 2 To tstSht.Range("A65536").End(xlUp).Row
　　　　Shimei = tstSht.Cells(rw, 1)
　　　　'その氏名のシートがあるか調べる
　　　　fndFlg = False
　　　　For Each ws In myWB.Worksheets
　　　　　　If ws.Name = Shimei Then
　　　　　　　　fndFlg = True
　　　　　　End If
　　　　Next
　　　　'その個人名のシートがなければ追加する
　　　　If fndFlg = False Then
　　　　　　Worksheets.Add after:=Worksheets(Worksheets.Count)
　　　　　　ActiveSheet.Name = Shimei
　　　　　　' ***ここは例***
　　　　　　ActiveSheet.Range("A1:E1") = Array("日付", "英語", "数学", "国語", "理科")
　　　　Else
　　　　　　Worksheets(Shimei).Activate
　　　　End If
　　　　'個人の得点を書き込む
　　　　With ActiveSheet
　　　　　　wrtRow = .Range("A65536").End(xlUp).Row + 1
　　　　　　.Cells(wrtRow, 1) = Hizuke
　　　　　　For c = 1 To KamokuSuu
　　　　　　　　.Cells(wrtRow, c + 1) = tstSht.Cells(rw, c + 1)
　　　　　　Next
　　　　End With
　　Next

　　'試験の成績Bookを閉じる
　　tstWB.Close
End Sub

お礼

ありがとうございました！
できました。
あぁ，ちゃんとマクロが書けるようになりたいです。
本当にありがとうございました。

回答No.2

sirouto

別の方法も補足しておきます・・・
まず、BOOK2の表を作った後に、B00K1の個人へ転記する部分の表をコピーします（空白でも構いません）このときにBOOK1へ貼り付ける時に右クリックの形式を選択して貼り付けで、リンク貼り付けを選びます。
貼り付けられた表にのセル内容には　=[Book2]Sheet1!B3　などとなっていると思います。この数式を参考にして、個人データのBOOK1の表を作っておいてください。
“！”の後の数字を変更するだけですから、簡単に出来ると思います。これでデータ入力時は、楽になると思いますが、入力前のbook1作成には、少し手間が増えるかもしれません。

お礼

試験を必ず全員が受けるわけではないし，
学籍番号などで管理しているわけではないので
通常のコピー＆ペーストと変わりないように思ってしまいました。

book2のファイルが届いたら自動的に，氏名を検索して，
その氏名のシートの再下段に日付を入れつつ，
試験の点数をコピーしたいので...

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

回答No.1

sirouto

これは、Accessの方がやりやすそうですが・・・どうしてもEXCElならば、テンプレートウイザードを利用してはどうでしょうか？　伝票などのBOOKに入力された数字をそのまま自動的にデータベースのBOOKなどへ転記するときに使います。伝票側を個人のBook1にして、転記される日付ごとの試験結果の方をbook2にするのです。
一度試してみてください。
　データの項目にテンプレートウイザードで（無ければ、EXCELのCD-ROMから「データ追跡機能付きテンプレートウイザード」アドインを追加組み込みしなければなりません）

お礼

早々のお返事，ありがとうございました。
そのものの機能があったのですね。

実はすでにいくつかデータがあるので，相談してみます。
この方が簡単そうなので，データの移動は厭わないかも知れません。

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