Excel VBA質問箱 IV

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

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


40508 / 76732 ←次へ | 前へ→

【41322】Re:検索について
回答  ハチ  - 06/8/5(土) 7:31 -

引用なし
パスワード
   ▼しげ さん:

おはようございます。
ステップ実行で試してみましたか?
どういった過程か確認するべきだと思います。

最後のデータですべて上書きしているような。
手元にテストデータがないので、
見た感じで回答します。間違ってたらスイマセン・・

>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
>

フォルダ内のファイル全部に実行したいなら・・・

1、フォルダ内のファイル一覧をThisWorkbook.WorkSheets(1)に作る。

2、できた一覧に"手動"で期間を埋めていく。

3、最初に作ったマクロを実行。(取得データが違うなら改良を)

で、いけるのでは?
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 お礼

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