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

質問

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 〇〇工務店]というファイル名

こんな夢のことができるコードを教えていただけないでしょうか。周りにはエクセルができる人はいますが、このようなVBAのコードが書ける人はおらず、なかなか進みません。
どなたかよろしくお願い致します。

回答No.8

end-u

で。
質問者さんが自分でメンテできるようになるにはどうすればいいかという話でしょうか。

ことExcelVBAに関しては
1)「新しいマクロの記録」の活用
2)VBE（VisualBasicEditor）、調べたい語句にマウスキャレットあてて[F1]キーでのHELPクイックアクセス
3)VBE[F8]キーでのステップ実行
4)VBE[Alt][v][s]の[ローカルウィンドウ]で変数調査
5)google検索
あとは「時間」と、労を厭わない「やる気」、があれば大抵の事は自力解決できるはず。
...って思ってます。
いろいろと試行錯誤しながら自分でやってみる事が大事。
とも。

まずはそのコードが何をやってるか理解するところからですね。
その過程で
>[フィルタオプション]を使うと別Bookにもダイレクトに抽出できるので調べてみると良いです。
http://www11.plala.or.jp/koma_Excel/contents6/mame6042/mame604201.html
http://support.microsoft.com/kb/402757/ja
などのサイトも参考になるでしょう。
マクロ、VBAについて初歩から系統だてて身につけていきたい場合は
書籍を探すのもいいですし
http://excelvba.pc-users.net/
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/index.html
http://www.asahi-net.or.jp/~ef2o-inue/top01.html
など、基礎から学べるサイトもいっぱいあります。

実務に即して必要性に駆られ、自ら学ぶ姿勢があり、『実践』すれば
何事も身についていくものだと思います。

では。
がんばってください :)

回答No.7

layy

＞周りにはエクセルができる人はいますが、
＞このようなVBAのコードが書ける人はおらず、なかなか進みません。

作成してもらったこのコードを今後どう保守していきますか？。
使用状況、条件が変わったりした場合対処できますか？。

もしここで回答者にもあなたにも何か見落としがあり、
それが重大なものなら仕事に支障があり取引先との損害賠償になりかねない。

自分ではなく他の人に作ってもらうという手段を選んではいるものの
この処理内容、結果に責任をもってください。
少なくともコメントを付与していただくなど、
何かあったときは回答者でなくあなた自身で解決できるように
心掛けましょう。

＞ end-uさんありがとうございます。これはすごいです！！

感心している場合ではないでしょう。

なんかこういう気でいるときが一番不具合を見落としそうなので
コメントさせてもらいました。

回答No.6

end-u

ぁ、失礼orz
>「支払い月」の列はB列　上記の調べたい年月日の対象となるデータです。
　　　ＡＡ　　ＡＢ　　　ＡＣ
１　仕入先　支払い月　　支払い月
２　=C3　　 =">="&E3　="<="&F3

でお願いします。

もしくは方針をちょっと変えて Q1:Q2 を作業列に。
特に事前設定は要りません。

Sub Macro2()
　　Const xlExcel8 = 56 'ver2007での2003互換FileFormat
　　Dim wb　　　 As Workbook
　　Dim data　　 As Range
　　Dim criteria As Range
　　Dim fName　　As String
　　Dim ver　　　As Long
　　Dim x　　　　As Long

　　On Error GoTo extLine

　　With ThisWorkbook.Sheets("Sheet1")
　　　　'最終行
　　　　x = .Cells(.Rows.Count, "F").End(xlUp).Row
　　　　'データ範囲
　　　　Set data = .Range("B5:Q" & x)
　　　　'検索条件範囲
　　　　.Range("Q1").ClearContents
　　　　.Range("Q2").Formula = "=AND($C$3=F6,$E$3<=B6,B6<=$F$3)"
　　　　Set criteria = .Range("Q1:Q2")
　　　　'抽出後Book名
　　　　fName = Format(.Range("E3").Value, "yyyymmdd～") _
　　　　　　　& Format(.Range("F3").Value, "yyyymmdd ") _
　　　　　　　& .Range("C3").Value
　　End With
　　'新規Book
　　Set wb = Workbooks.Add(xlWBATWorksheet)
　　'[フィルタオプション]
　　data.AdvancedFilter Action:=xlFilterCopy, _
　　　　　　　　　　　　CriteriaRange:=criteria, _
　　　　　　　　　　　　CopyToRange:=wb.Sheets(1).Range("A1"), _
　　　　　　　　　　　　Unique:=False
　　'抽出なし
　　If wb.Sheets(1).UsedRange.Rows.Count = 1 Then
　　　　MsgBox "no data"
　　　　wb.Close False
　　Else
　　　　'Versionチェック
　　　　If Val(Application.Version) < 12 Then
　　　　　　ver = xlNormal
　　　　Else
　　　　　　ver = xlExcel8
　　　　End If
　　　　wb.SaveAs Filename:=ThisWorkbook.Path & "\" & fName, _
　　　　　　　　　FileFormat:=ver
　　End If

extLine:
　　Set criteria = Nothing
　　Set data = Nothing
　　Set wb = Nothing
　　If Err.Number <> 0 Then
　　　　MsgBox Err.Number & " : " & Err.Description
　　End If
End Sub

回答No.5

noname#192382

すでに幾つかの回答がありますが、私も答えさせてください。マクロで組みました。データ数をデータとして与えるようにしています。
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2010/8/20 ユーザー名 :
'
Dim mygyo As Integer, mygyo2 As Integer, gyoend As Integer
'シート2にタイトルコピー
Sheets("Sheet1").Select
Range("B5:Q5").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B5:Q5").Select
ActiveSheet.Paste

'抽出条件をシート2にコピー
Sheets("Sheet1").Select
Range("C3:F3").Select
Selection.Copy
Sheets("Sheet2").Select
Range("C3:F3").Select
ActiveSheet.Paste
'最終データを入力
gyoend = 10
'条件に合うデータをシート2にコピー

mygyo2 = 6
For mygyo = 6 To gyoend
Sheets("Sheet1").Select
If Cells(mygyo, 2) > Cells(3, 5) And Cells(mygyo, 2) < Cells(3, 6) And Cells(mygyo, 6) = Cells(3, 3) Then
'If Cells(mygyo, 6) = Cells(3, 3) Then

Range(Cells(mygyo, 2), Cells(mygyo, 15)).Select
Selection.Copy
Sheets("Sheet2").Select
Range(Cells(mygyo2, 2), Cells(mygyo2, 15)).Select
ActiveSheet.Paste
mygyo2 = mygyo2 + 1
'MsgBox mygyo.Value
Else
End If
Next

'

お礼

ありがとうございました。こちらもすごく参考になりました。

回答No.4

aloha8761

Sub 抽出()
Dim i As Long
Dim atai As Variant

i = 6
Do Until Cells(i, 2).Value = ""

If Cells(i, 2).Value >= 開始セル値 And cell(i, 2).Value <= 終了セル値 And Cells(i, 6).Value = 仕入れ先のセル値 Then

atai = Range(Cells(i, 2), Cells(i, 最後のフィールド行数).Value)
'転記先のセル範囲をここに書くべし！

End If

i = i + 1
Loop

End Sub

これでataiにセル範囲のデータが格納されました！

日本語で書いたところは自分でセル値をあてがってください！
日付の判定はシリアル値で行います！
これをあとどう使うかです！

お礼

ありがとうございました。大変参考になりました。

回答No.3

end-u

[フィルタオプション]を使うと別Bookにもダイレクトに抽出できるので調べてみると良いです。

抽出条件用の作業エリアとして未使用セルを使います。
仮に AA1:AC2 とします。
　　　ＡＡ　　ＡＢ　　　ＡＣ
１　仕入先　年月日　　年月日
２　=C3　　 =">="&E3　="<="&F3

条件とする列の項目名を１行目に入力。
それぞれの条件を入力したセルを参照する数式を２行目に入力。

あとは
Sub Macro1()
　　Const xlExcel8 = 56 'ver2007での2003互換FileFormat
　　Dim wb　　　 As Workbook
　　Dim data　　 As Range
　　Dim criteria As Range
　　Dim fName　　As String
　　Dim ver　　　As Long
　　Dim x　　　　As Long

　　On Error GoTo extLine

　　With ThisWorkbook.Sheets("Sheet1")
　　　　'最終行
　　　　x = .Cells(.Rows.Count, "F").End(xlUp).Row
　　　　'データ範囲
　　　　Set data = .Range("B5:Q" & x)
　　　　'検索条件範囲
　　　　Set criteria = .Range("AA1:AC2")
　　　　'抽出後Book名
　　　　fName = Format(.Range("E3").Value, "yyyymmdd～") _
　　　　　　　& Format(.Range("F3").Value, "yyyymmdd ") _
　　　　　　　& .Range("C3").Value
　　End With
　　'新規Book
　　Set wb = Workbooks.Add(xlWBATWorksheet)
　　'[フィルタオプション]
　　data.AdvancedFilter Action:=xlFilterCopy, _
　　　　　　　　　　　　CriteriaRange:=criteria, _
　　　　　　　　　　　　CopyToRange:=wb.Sheets(1).Range("A1"), _
　　　　　　　　　　　　Unique:=False
　　'抽出なし
　　If wb.Sheets(1).UsedRange.Rows.Count = 1 Then
　　　　MsgBox "no data"
　　　　wb.Close False
　　Else
　　　　'Versionチェック
　　　　If Val(Application.Version) < 12 Then
　　　　　　ver = xlNormal
　　　　Else
　　　　　　ver = xlExcel8
　　　　End If
　　　　wb.SaveAs Filename:=ThisWorkbook.Path & "\" & fName, _
　　　　　　　　　FileFormat:=ver
　　End If

extLine:
　　Set criteria = Nothing
　　Set data = Nothing
　　Set wb = Nothing
　　If Err.Number <> 0 Then
　　　　MsgBox Err.Number & " : " & Err.Description
　　End If
End Sub

こんな感じです。
シート名などは適宜変更してください。

お礼

申し訳ありません。私の認識違いでした。ばっちりです。
もう少し確認させてくださいね。ありがとうございます。

補足

end-uさんありがとうございます。これはすごいです！！
一点、実行してみたところ、結果が指定期間が抽出されず、仕入先名だけ抽出されているみたいです。
私の設定の勘違いかわかりませんが・・・

回答No.2

imogasi

対先ほど抜き出しの質問に答えました
http://okwave.jp/qa/q6123068.html
の＃３です。
マクロの記録を開始して、そこに書いてある操作を、質問者の場合に合わせて行い、マクロの記録を採ってください。
ここで今後変えるべき個所はコードを修正してください。
その場合、最低、元データの範囲はEnd(xlup).RowやUsedRange、CurrentRegionを調べて勉強のこと。
他ファイルへのコピー貼り付けは、シートタブで右クリックし、「シートの移動またはコピー」で「移動先」を他ブックを指定し、「コピーを作成する」を択ぶ。
この操作のマクロの記録を採ってください。
ーー
条件による、抜き出し方法（コード）は色々なロジックがが考えられるが、エクセルにあるものを使うのは、安定している（バグがない）。
質問者は、VBAにあまり詳しくないようなので、色々書かない。
ーー
外に年月日の前後は、エクセルではセルの値は、日付シリアル値という正の整数なので、そういう考えで
対処すること。日付が文字列だと変換してからの話になる。
http://www11.plala.or.jp/koma_Excel/contents6/mame6043/mame604303.html
に日付の前後の設定例が載っている。「より小さい」は日付列条件列を別に設ける（AND条件だから）
例　D1:E2
日付 日付
>2010/8/2 <2010/8/7

回答No.1

MackyNo1

特定の日付以上かる特定の日付以下のフィルタを行った操作をマクロの記録で記録すれば基本的なコードが取得できますが、具体的にどの部分がわからないのでしょうか？
簡便には、条件の部分をセルの値に置き換えればよいと思います。

このままの質問では、まさにマクロコード全体を作成する丸投げ質問のように思われますが、このようなＱ＆Ａサイトはプログラム作成を請け負いしているわけではないので、わからない部分をピンポイントで絞って質問されたほうが良いと思います（そうしないと、プログラムのバグやミスなどに自分で対応できないことになり重大なエラーに結び付く可能性があります）。