1282309580 VBAのコードを教えていただけないでしょうか。

概要はリスト形式のデータの複数の条件に合うデータをオートフィルタで抽出して、その結果を別ファイルにする、というものです。用途は建設業のデータ入力です。

リスト形式のシート「記入用」は次のようになっています。

・B5:Qはデータを記入する領域。(Qの下の行はどれだけになるかわかりませんが、今は500ぐらいまです) ※5行目は見出し行です。
・C3に仕入れ先の会社を入力
・E3・F3はそれぞれ年月日を入力して、検索するときに何月何日から何月何日の間、というようにするためのセルです。E3が調べたい年月日の始めの日、F3は調べたい年月日の終わりの日です。
・「支払い月」の列はB列 上記の調べたい年月日の対象となるデータです。
・「仕入先」はF列

エクセルは2003を使っていますが、2007でも使用します。

以上の条件ですが、実現したいことは、
(例)
●2010/4/1から2010/7/31までの間で、仕入先が〇〇工務店のデータを抽出
●その抽出結果に名前をつけて別ファイルで保存。その保存名は検索した年月日(from to)+仕入先名
 この例の場合、[20100401~20100731 〇〇工務店]というファイル名

コードを教えていただけないでしょうか。

回答の条件
  • 1人10回まで
  • 13歳以上
  • 登録:2010/08/20 22:06:22
  • 終了:2010/08/27 22:10:02

回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692010/08/20 22:42:49

ポイント10pt

こんな感じでどうでしょうか。

最初のところの保存先を実際の環境に変更してください。

Sub Macro()
    '実際の保存先に変更してください
    Const SavePath = "C:\Users\hogehoge\Desktop\"
    Dim newBK As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim r As Long
    
    Set ws = ActiveSheet
    Set newBK = Workbooks.Add
    
    lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
    r = 6

    ws.Range("1:5").Copy newBK.Worksheets(1).Range("1:5")

    For i = 6 To lastRow
        If ws.Cells(i, "B").Value >= ws.Range("E3").Value And _
            ws.Cells(i, "B").Value <= ws.Range("F3").Value Then
            ws.Rows(i).Copy newBK.Worksheets(1).Rows(r)
            r = r + 1
        End If
    Next i
    
    newBK.SaveAs SavePath & Format(ws.Range("E3").Value, "yyyymmdd") _
        & "~" & Format(ws.Range("F3").Value, "yyyymmdd") & " " & ws.Range("C3").Value
    newBK.Close
End Sub

質問者が未読の回答一覧

 回答者回答受取ベストアンサー回答時間
1 ask001 49 7 0 2010-08-21 10:51:36

コメントはまだありません

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません