| |
こんばんは。
教えていただいたとおりに書いてみるとうまくいきました！
ありがとうございます！！
しかし・・・フォルダ内のファイルすべてのデータを
転記させるようにしなければならなくなりました。
が、最終行end(xlup)の使い方が間違っているのか、フォルダ内のファイルを拾う
コードが間違っているのかうまく作動しません。
ファイルが１５個あれば１５個目に拾ったファイルのデータのみ
１５行並びます。さらに４月のデータはきちんと４月の列に入っていたり
１０月のデータが４月に入っていたりします。
たとえば
10月 11月 12月 1月 2月 3月 4月
120 130 140 150 160 170 180
が１５個目のファイルデータとすると
１４個分のデータは入らず
BOOK1sheet2には
2006/4月 5月 6月 7月 8月 9月・・・・
180 0 0 0 0 0 ・・・
160 170 180 0 0 0 ・・・
120 130 140 150 160 170 180 190・・・
という感じです。
伝わるでしょうか。。。
Sub test()
Dim file As String
Dim theDir As String
Dim wb As Workbook
Dim flg As Boolean
flg = True
Application.ScreenUpdating = False
theDir = "C:\documents and Settings\集計\練習"
file = Dir(theDir & "\*.xls")
Do While thename <> ""
Set wb = Workbook.Open(theDir & "\" & file)
Call subtest(wb, flg)
flg = False
wb.Close savechanges:=False
file = Dir
Loop
End Sub
Sub subtest(wb as workbook,flg)
Dim getu() As Long
Dim ws As Worksheet
Dim buf As Variant
Dim st As Integer
Dim i As Long
Dim R, Row, LastRow As Long
With ThisWorkbook.Worksheets(1)
Row = .Range("A65536").End(xlUp).Row
For R = 2 To Row
Set ws = wb.Worksheets(2)
LastRow = ws.Range("C65536").End(xlUp).Row
buf = ws.Range(ws.Range("C" & LastRow), ws("C" & LastRow).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(2).Cells(R, 2).Resize(, 12).Value = getu
End With
Set wb = Nothing
Set ws = Nothing
Erase buf, getu
End Sub
ここで書いてしまってよいのかどうかわからなかったのですが
宜しくお願い致します。
|
|
しげ
- 06/8/4(金) 23:27 -
