1～12月迄の売上データから月度ごとに抽出するには

いつもお世話になります。
OSは　WIN10 エクセルは　2016　です。

例えば、
参照図で20日〆の6月(A6:A13)の売上対象で
F列、G列に抽出したいのです。


※1　同じ売上月でも納品日が違えば抽出する。
※2　1～12月迄のデータがあります。

F列、G列に抽出したいのですがご指導いただきたいです。
よろしくお願いします。

目的は抽出された表をもとに請求書　入金などの管理に役立てたいです。

質問者からの補足コメント

• 

  忘れましたので追加捕捉します。
  ※3　E1　に　1～12で該当する月を入れます。
  　　 この場合は　6　と入れています。

    補足日時：2018/05/08 13:19

• 

  早速のご質問をありがとうございます。
  1) I列の件数は無視で・・
  答え
  分かりやすくする溜めにお示ししました。
  無視していただいて結構です
  
  2) ＞※1　同じ売上月でも納品日が・・
  答え
  日々の営業をデータしています。
  例えば　
  ID 0030
  納品日 5/3 5/20
  たまたま説明用としてわかりやすくするためほんの一部だけしか示していませんが
  同じID(会社)で納品日の違う取引はあります。
  このIDが同じで納品日が違うか何回あるかは定かでありません。
  3) 納品日が同じでもIDが違えば分けなきゃ・・
  答え
  先ほども答えましたがどちらかというと　納品別でIDですかね。
  納品日同じでIDが違ったとしても分けて表示したい。
  よろしくお願いします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2018/05/08 16:54

• 

  ありがとうございます。
  VBAは素人ですが省力化したいのでよろしくお願いいたします。
  でもすごいですね。

  No.2の回答に寄せられた補足コメントです。 補足日時：2018/05/08 18:09

• 

  ありがとうございます。
  
  テストした結果、うまくできましたが
  私の望みが下記のように2点修正をお願いします。
  
  実行の結果
  
  F列　F2 10 F3 20 を文字列にしていただきたい
  　 F2 0010 F3 0020 という具合にです。
  
  G列は
  　　 G2 4月21日 をmm/dd形式に
  G2 04/21
  よろしくお願いいたします。

  No.4の回答に寄せられた補足コメントです。 補足日時：2018/05/08 21:39

No.3 ベストアンサー 回答者： mike_g 回答日時： 2018/05/08 18:16

お示しの表が Sheet1 にあるとして、添付図に示す Sheet2 を作成します。

Sheet2 において、
１．式 =IF(Sheet1!$A1="","",Sheet1!A1) を入力したセル A1 を右に２列
￣￣オートフィル２．範囲 A1:C1 を下方に好きなだけ(此処では 1000行目
￣￣まで)コピー
３．下記の各セルにそれぞれの右側に示す式 を入力
￣￣ D2: =IF(A2="","",B2&" "&C2)
￣￣ E2: =IF(A2="","",COUNTIF(D$2:D$1000,D2))
￣￣ F2: =IF(A2="","",IF(COUNTIF(D$2:D2,D2)=1,D2,""))
４．範囲 D2:F2 のフィルハンドルを「エイヤッ！」とダブルクリック

Sheet1 において、
５．G/標準"月度"
￣￣に書式設定したセル E1 に数値の 6 を入力
６．下記の各セルにそれぞれの右側に示す式 を入力
￣￣ F2: =IFERROR(INDEX(Sheet2!C$1:C$1000,SMALL(IF((Sheet2!$A$1:$A$1000=$E$1)*(Sheet2!$F$1:$F$1000<>""),ROW($E$1:$E$1000),""),ROW(A1))),"")
￣￣ G2: =IFERROR(INDEX(Sheet2!B$1:B$1000,SMALL(IF((Sheet2!$A$1:$A$1000=$E$1)*(Sheet2!$F$1:$F$1000<>""),ROW($E$1:$E$1000),""),ROW(B1))),"")
￣￣ I2: =IFERROR(INDEX(Sheet2!E$1:E$1000,SMALL(IF((Sheet2!$A$1:$A$1000=$E$1)*(Sheet2!$F$1:$F$1000<>""),ROW($E$1:$E$1000),""),ROW(D1))),"")
【お断り】上式は全て必ず配列数式として入力のこと
７．範囲 F2:I2 を下方に必要十分なだけオートフィル

この回答へのお礼

早速のご指導をありがとうございます。
うまくできて感謝感激です。

お礼日時：2018/05/08 19:10

No.5 回答者： めぐみん_ 回答日時： 2018/05/09 04:47

No.4です。

基本的には元のB・C列の書式に合わせているはずですが明確に指定というのであれば、

Sub abc_2()
　　Dim Dic As Object
　　Dim st As String, r As Range
　　Dim tuki As Integer

　　Set Dic = CreateObject("Scripting.Dictionary")

　　With Worksheets("Sheet1") '★　仮にSheet1
　　　　.Range("F:G").ClearContents
　　　　.Range("F1:G1").Value = Array("ID", "納品日")
　　　　.Columns("F:G").HorizontalAlignment = xlCenter
　　　　.Columns("F:F").NumberFormatLocal = "@" ' ★.Columns("C:C").NumberFormatLocal
　　　　.Columns("G:G").NumberFormatLocal = "mm/dd" ' ★.Columns("B:B").NumberFormatLocal
　　　　tuki = .Range("E1").Value
　　　　For Each r In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
　　　　　　If r.Value = tuki Then
　　　　　　　　st = tuki & "_" & r.Range("B1").Text & "_" & r.Range("C1").Text
　　　　　　　　If Not Dic.Exists(st) Then Dic.Add st, Array(r.Range("C1").Text, r.Range("B1").Value2)
　　　　　　End If
　　　　Next
　　　　.Range("F2").Resize(Dic.Count, 2).Value = _
　　　　Application.Transpose(Application.Transpose(Dic.Items))
　　End With
　　Set Dic = Nothing
End Sub

このような感じでしょうか？

この回答へのお礼

ありがとうございます。
お陰様でうまくできました。

今しがたVBAを始めたばかりで勉強になります。

お礼日時：2018/05/09 05:52

No.4 回答者： めぐみん_ 回答日時： 2018/05/08 19:41

こんな感じでどうでしょう？（罫線は入れてませんが・・・）

Sub abc()
　　Dim Dic As Object
　　Dim st As String, r As Range
　　Dim tuki As Integer

　　Set Dic = CreateObject("Scripting.Dictionary")

　　With Worksheets("Sheet1") '★　仮にSheet1
　　　　.Range("F:G").ClearContents
　　　　.Range("F1:G1").Value = Array("ID", "納品日")
　　　　.Columns("F:G").HorizontalAlignment = xlCenter
　　　　.Columns("F:F").NumberFormatLocal = .Columns("C:C").NumberFormatLocal
　　　　.Columns("G:G").NumberFormatLocal = .Columns("B:B").NumberFormatLocal
　　　　tuki = .Range("E1").Value
　　　　For Each r In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
　　　　　　If r.Value = tuki Then
　　　　　　　　st = tuki & "_" & r.Range("B1").Text & "_" & r.Range("C1").Text
　　　　　　　　If Not Dic.Exists(st) Then Dic.Add st, Array(r.Range("C1").Text, r.Range("B1").Text)
　　　　　　End If
　　　　Next
　　　　.Range("F2").Resize(Dic.Count, 2).Value = _
　　　　Application.Transpose(Application.Transpose(Dic.Items))
　　End With
　　Set Dic = Nothing
End Sub

No.2 回答者： めぐみん_ 回答日時： 2018/05/08 18:02

ところでこれってVBA使っても良いですか？（わたし数式苦手なんです。

ちょっと複雑な数式覚えるより先にVBA覚え始めたもので。）

No.1 回答者： めぐみん_ 回答日時： 2018/05/08 16:22

＞F列、G列に抽出したいのです。

I列の件数は無視で構わない？

＞※1　同じ売上月でも納品日が違えば抽出する。

納品日が同じでもIDが違えば分けなきゃいけない？（それともこんな事はあり得ない？）