Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


40509 / 76732 ←次へ | 前へ→

【41321】Re:検索について
発言  しげ  - 06/8/4(金) 23:27 -

引用なし
パスワード
   こんばんは。
教えていただいたとおりに書いてみるとうまくいきました!
ありがとうございます!!

しかし・・・フォルダ内のファイルすべてのデータを
転記させるようにしなければならなくなりました。

が、最終行end(xlup)の使い方が間違っているのか、フォルダ内のファイルを拾う
コードが間違っているのかうまく作動しません。
ファイルが15個あれば15個目に拾ったファイルのデータのみ
15行並びます。さらに4月のデータはきちんと4月の列に入っていたり
10月のデータが4月に入っていたりします。
たとえば
10月 11月 12月 1月  2月  3月   4月  
120 130  140  150  160 170   180  
が15個目のファイルデータとすると
14個分のデータは入らず

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

ここで書いてしまってよいのかどうかわからなかったのですが
宜しくお願い致します。
1 hits

【41092】検索について しげ 06/7/28(金) 22:20 質問
【41118】Re:検索について kobasan 06/7/30(日) 22:40 発言
【41119】Re:検索について しげ 06/7/31(月) 0:02 発言
【41122】Re:検索について ハチ 06/7/31(月) 8:36 発言
【41127】Re:検索について ハチ 06/7/31(月) 14:32 発言
【41150】Re:検索について しげ 06/7/31(月) 22:40 お礼
【41153】Re:検索について ハチ 06/7/31(月) 23:52 発言
【41321】Re:検索について しげ 06/8/4(金) 23:27 発言
【41322】Re:検索について ハチ 06/8/5(土) 7:31 回答
【41337】Re:検索について しげ 06/8/6(日) 18:02 発言
【41424】Re:検索について しげ 06/8/9(水) 22:02 お礼
【41125】Re:検索について kobasan 06/7/31(月) 14:00 回答
【41151】Re:検索について しげ 06/7/31(月) 22:50 お礼

40509 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free