EXCEL 2007 VBAによる時系列データの更新について

質問

EXCEL 2007 VBAによる時系列データの更新について

当方初心者です。意外と簡単に解決できるものかは分かりませんが質問させて頂きます。
どなたかご教授頂ければと思います。

"A.xls"の"Sheet1"に

2010/10/4 6:00　　　100　　　101　　　100　　　101
2010/10/5 6:00　　　102　　　103　　　101　　　102
2010/10/6 6:00　　　103　　　104　　　100　　　103
2010/10/7 6:00　　　103　　　105　　　100　　　102
2010/10/8 6:00　　　103　　　105　　　100　　　102
2010/10/11 6:00　　　102　　　107　　　100　　　102
2010/10/12 6:00　　　102　　　106　　　100　　　103

というように毎日蓄積されたデータを1行ごとに保存してあります。

そして"B.xls"の"Sheet1"には

2010/10/8 6:00　　　103　　　105　　　100　　　102
2010/10/11 6:00　　　102　　　107　　　100　　　102
2010/10/12 6:00　　　102　　　106　　　100　　　103
2010/10/13 6:00　　　101　　　104　　　100　　　102
2010/10/14 6:00　　　100　　　102　　　100　　　100
2010/10/15 6:00　　　101　　　103　　　100　　　100

のように最新のデータが保存されてあり、このデータを蓄積してある
データ("A.xls"の"Sheet1")にVBAによってコピーしたいのです。

ただしこの場合、既に保存してある期間のデータよりも以降
(上記例では両データ共にA列に日付データが入力されてあり、
2010/10/13 6:00以降)のデータを"A.xls"の"Sheet1"の

2010/10/12 6:00　　　102　　　106　　　100　　　103

の次の行からコピーしていきたいのですが、どのような方法で
可能なのでしょうか？
まだ初心者ですがどなたか教えていただければと存じます。
宜しくお願い申し上げます。

回答No.2

imogasi

１日に（同一日付）で２行のデータは無いと仮定すれば良いのか？
それなら簡単ではないか。
（１）AのSheet1の最終行を捉える
（２）その行のA列の日付を取得する
（３）BのSheet1のA列で（２）の日付の行番号を求める
（４）BのSheet1のA列の最終行番号を求める
（５）Bのシートの（３）＋１から（４）の（最終）行をコピーし
AのSheet1の最終行の次に貼り付ける
こういうロジックでおかしくないか。
よいならコードに実現する。
ーーーー
その際必要な要素技術として
A,Bのブックを開く、は判るだろう
（A）最終行を捉えるコード
Googleで「エクセル vba 最終行」で照会。
（B）コピー・貼り付けのコード
Destination貼り付け先が他ブックの範囲になるが、その指定方法を勉強
（C）Bのシートの（３）＋１から（４）の（最終）行までの範囲を捉えるコード
（D）BブックSheet1のA列で指定日付行を見つけるコード
　　判らなければ１行づつ聞いてし次行に行け
丸投げで完成品コピーを期待しないで、上記を参考にやってみること。

回答No.1

Wendy02

>日付データが入力されてあり
シリアル値だと思います。その場合は、Match関数のValue2 で検索すると確実です。
Findメソッドでは、一致は検索出来ますが、それ以上のものをさがすのに厄介です。
なお、ファイル名の取得には工夫が必要かもしれません。

'// 標準モジュール
Sub ConvertData()
　Dim trSh As Worksheet, acSh As Worksheet
　Dim r As Range, Serchval As Variant
　Dim rw As Variant, rw1 As Variant, larw As Variant

　Const COL As Long = 5 'コピー列5
　Set trSh = Workbooks("A.xls").Worksheets("Sheet1")　''構築データ
　Set acSh = Workbooks("B.xls").Worksheets("Sheet1")　''出力データ

　With trSh
　　Set r = .Cells(Rows.Count, 1).End(xlUp)
　End With
　Serchval = r.Value2
　Application.ScreenUpdating = False
　With acSh
　　rw = Application.Match(Serchval, .Columns(1), 1)
　　If IsError(rw) Then rw = 1
　　rw1 = Application.Match(Serchval, .Columns(1), 0)
　　If Not (IsError(rw1)) Then rw = rw + 1
　　If acSh.Cells(Rows.Count, 1).End(xlUp).Row > rw Then
　　　.Range(.Cells(rw, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, COL).Copy r.Offset(1)
　　End If
　End With
　Application.ScreenUpdating = True
　Set trSh = Nothing: Set acSh = Nothing
End Sub