| |
▼しげ さん：
おはようございます。
ステップ実行で試してみましたか？
どういった過程か確認するべきだと思います。
最後のデータですべて上書きしているような。
手元にテストデータがないので、
見た感じで回答します。間違ってたらスイマセン・・
>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
'ここの変数名"Row"はまずいのでは？Row関数と混同しそうです。
> Dim R, Row, LastRow As Long
>
> With ThisWorkbook.Worksheets(1)
> Row = .Range("A65536").End(xlUp).Row
'ここでループすることで上書きしているような・・
'ループはDirの箇所でしてますよね？
'一回だけ実行すれば良いと思うけど
'とすると期間はどうやって抽出するんですかねぇ？
> For R = 2 To Row
> Set ws = wb.Worksheets(2)
'前回は、2行目のデータとなっていましたが最終行に変更になった？
> LastRow = ws.Range("C65536").End(xlUp).Row
> buf = ws.Range(ws.Range("C" & LastRow), ws("C" & LastRow).End(xlToRight))
'期間の情報と開いているBook"wb"をどうやって関連付けてるんですか？
> 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
>
フォルダ内のファイル全部に実行したいなら・・・
１、フォルダ内のファイル一覧をThisWorkbook.WorkSheets(1)に作る。
２、できた一覧に"手動"で期間を埋めていく。
３、最初に作ったマクロを実行。（取得データが違うなら改良を）
で、いけるのでは？
|
|
ハチ
- 06/8/5(土) 7:31 -
