Excel VBA質問箱 IV

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

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


40697 / 76732 ←次へ | 前へ→

【41127】Re:検索について
発言  ハチ  - 06/7/31(月) 14:32 -

引用なし
パスワード
   >質問1
>Book1のは、変更可能なのでしょうか?
>>プロジェクト名     期間       
>>プロジェクト1 2005/10/1〜2006/4/30
>ここの期間の部分を「開始日」「終了日」と
>2セルにわけるほうが処理しやすいのでは?

B列に開始日が入っているとして・・

>
>質問2
>>BOOK2(プロジェクト1)
>このBook名とプロジェクト名はどうやって関連付けているんですか?

ファイル名が プロジェクト名.xlsになっているとして・・

>質問3
>Book2以降には、年を示す情報は一切無しですか?

無しとして・・

>質問4
>各月のセルが列方向に順番にならんでいるのなら、
>始めの位置さえ決めれば一月ごとに検索をかける必要はない と思いますが、
>そのあたりはどうでしょうか?  

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

0 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 お礼

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