|
>質問1
>Book1のは、変更可能なのでしょうか?
>>プロジェクト名 期間
>>プロジェクト1 2005/10/1〜2006/4/30
>ここの期間の部分を「開始日」「終了日」と
>2セルにわけるほうが処理しやすいのでは?
B列に開始日が入っているとして・・
>
>質問2
>>BOOK2(プロジェクト1)
>このBook名とプロジェクト名はどうやって関連付けているんですか?
ファイル名が プロジェクト名.xlsになっているとして・・
>質問3
>Book2以降には、年を示す情報は一切無しですか?
無しとして・・
>質問4
>各月のセルが列方向に順番にならんでいるのなら、
>始めの位置さえ決めれば一月ごとに検索をかける必要はない と思いますが、
>そのあたりはどうでしょうか?
A2から各月のデータが空白なく順番にならんでいるとして・・・
勝手に想像して作ってみました。
Option Explicit
Sub Test()
Dim Getu() As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim St As Integer
Dim i As Long
Dim R, LastR As Long
Dim buf As Variant
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Sheet1")
LastR = .Range("A65536").End(xlUp).Row
For R = 2 To LastR
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & .Cells(R, 1).Value & ".xls")
Set ws = wb.Worksheets("Sheet1")
buf = ws.Range(ws.Range("A2"), ws.Range("A2").End(xlToRight))
St = DateDiff("m", .Cells(R, 2).Value, "2006/04/01") + 1
ReDim Getu(11)
For i = 0 To 11
If i + St > UBound(buf, 2) Then Exit For
If i + St > 0 Then
Getu(i) = buf(1, St + i)
End If
Next i
ThisWorkbook.Worksheets("Sheet2").Cells(R, 1).Value = .Cells(R, 1).Value
ThisWorkbook.Worksheets("Sheet2").Cells(R, 2).Resize(, 12).Value = Getu
wb.Close False
Next R
End With
Application.ScreenUpdating = True
Set wb = Nothing
Set ws = Nothing
Erase buf, Getu
End Sub
|
|