| |
>質問１
>Book1のは、変更可能なのでしょうか？
>>プロジェクト名 期間
>>プロジェクト１ 2005/10/1〜2006/4/30
>ここの期間の部分を「開始日」「終了日」と
>2セルにわけるほうが処理しやすいのでは？
B列に開始日が入っているとして・・
>
>質問２
>>ＢＯＯＫ２（プロジェクト１）
>このBook名とプロジェクト名はどうやって関連付けているんですか？
ファイル名が プロジェクト名.xlsになっているとして・・
>質問３
>Book2以降には、年を示す情報は一切無しですか？
無しとして・・
>質問４
>各月のセルが列方向に順番にならんでいるのなら、
>始めの位置さえ決めれば一月ごとに検索をかける必要はない と思いますが、
>そのあたりはどうでしょうか？
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
|
|
ハチ
- 06/7/31(月) 14:32 -
