[[20130627083141]]　『リストから受付月ごとに抽出』（みなみ）　ページの最後に飛ぶ

『リストから受付月ごとに抽出』（みなみ）

おはようございます。

受付リストシートを１年分作成し、そこから指定した受付月・変更月・実行月それぞれで別シートに抽出というのを作りたいのですがなかなかうまくいきません。
ご指導をお願い致します。

【リストシート】

 Ａ　　Ｂ　　Ｃ　　Ｄ　　Ｅ　 Ｆ  Ｇ  Ｈ  Ｉ  Ｊ  Ｋ  Ｌ  Ｍ  Ｎ  Ｏ  Ｐ    Ｑ     Ｒ     Ｓ
番号 受付日 住所 氏名 ﾌﾘｶﾞﾅ 種別 (ｲ) (ﾛ) (ﾊ) (ﾆ) 期間 (ﾎ) (ﾍ) (ﾄ) (ﾁ) (ﾘ) 実行日 変更日 確定日

【抽出シート】

 Ａ　　Ｂ　　Ｃ　　Ｄ　　Ｅ　 Ｆ  Ｇ  Ｈ   Ｉ   Ｊ   Ｋ    Ｌ  
平成25年度 7月実行分　←日付データをユーサー定義で表示(実際は2013/7/1)
番号 受付日 住所  氏名  種別 (ﾊ)  (ﾆ) 期間 (ﾎ)  (ﾍ)  (ﾄ)  実行日

平成25年度 7月変更分
番号受付日住所氏名種別 (ﾊ) (ﾆ) 期間 (ﾎ) (ﾍ) (ﾄ) 変更日

平成25年度 7月確定分
番号受付日住所氏名種別 (ﾊ) (ﾆ) 期間 (ﾎ) (ﾍ) (ﾄ) 確定日

 やりたいことが見えてきませんが・・・
 １、【抽出シート】は、例えば源泉徴収票のような印刷や表示を目的としたカードのようなものですか？
 ２、リスト及び票の作りに関して
 　　【リストシート】には実行日、変更日、確定日が「1つの行」に記入されていて、
 　　【抽出シート】の項目は実行日、変更日、確定日と3つありますが、
 　　抽出されたデータはすべて同じデータになりませんか？
 　　実行、変更、確定で別のデータを表示させたいのでは・・・？
 ３、キーとなる項目はどれですか？
 　　（例えば番号なら）番号は一意（ユニーク）な値ですか？
 （稲葉）

説明不足で申し訳ありません。
あと【抽出シート】の一番上を間違えてました。
正しくは7月受付け分です。

１、　【抽出シート】は毎月の報告用です。また各月の件数確認用でもあります。
２、３毎月の報告でリストから該当データ抽出するのですが、報告月に該当する
　　　上段：受付分の一覧（受付日参照)
　　　中断：変更分の一覧（変更日参照)
　　　下段：確定分の一覧（確定日参照）を抽出したいんです。
　　　番号は頭から通し番号で、そのまま抽出しています。

ちなみにMONTH関数を使ってVLOOKUP関数で抽出しようとしていますが、思ったようにできません(ToT)
（みなみ）

 例えば
 実行日：2013/5/10
 変更日：2013/7/10
 確定日：2013/7/20
 というデータがあった場合、７月分の報告には、「変更分」と「確定分」に出力され、
 「受付分」には出力されないということですね？

 キーは各日にちで抽出ですね。

 あと聞き忘れましたが、各○○分の行数は固定ですか？　変動ですか？

 （こうやって聞いている間に誰かが答え出してくれるはず・・！）
 （稲葉）

お手数をおかけいたします。
そうですね、受付けた日に「変更」「確定」は無いですので「受付分」には出力されません。
「受付日」「変更日」「確定日」の各日にちを参照してそれぞれ抽出になります。

それぞれの表の行数は20件程度でしょうか、増えてもかまいません。

（みなみ）

Sub 抽出()

    Dim F
    Dim D
    Dim XDay As Date
    Dim L As Range
    Dim C As Range

    Set L = Sheets("リストシート").Range("A1:S100")    'データの範囲　項目名を含んでください。
    XDay = Range("A1").Value
    Range("A2:L100").ClearContents

    With Sheets("抽出シート")
        For i = 0 To 2
            '抽出条件の項目名　リストの項目と一致させてください
            D = Split("受付日,変更日,確定日", ",")

            '抽出する項目名、リストの項目と一致させてください
            F = Split("番号,受付日,住所,氏名,種別,(ﾊ),(ﾆ),期間,(ﾎ),(ﾍ),(ﾄ)," & D(i), ",")

            Set C = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 2).Resize(, UBound(F, 1) + 1)
            C = F

            .Range("AA1:AB2") = D(i)
            .Range("AA2") = ">=" & XDay
            .Range("AB2") = "<=" & DateAdd("m", 1, XDay) - 1

            L.AdvancedFilter _
                Action:=xlFilterCopy, _
                CriteriaRange:=.Range("AA1:AB2"), _
                CopyToRange:=C, _
                Unique:=False
        Next i
        .Range("AA1:AB2").ClearContents
    End With
End Sub

 こんな感じでいかがでしょう？
 但し、抽出先のA～L列は抽出するときに消えてしまいますので、最下段に何か入力されている場合は
 注意してください。
 AA1:AB2のセル勝手に使っています。

 （稲葉）

うまくいきました！
自動で表まで出来るなんてびっくりです。
どうもありがとうございました。

（みなみ）

何度もすみません。

行をA3に抽出させようとしていたら実行エラーが出たのですが、
下記のところがおかしいみたいなんですけど良く分かりません(ToT)

L.AdvancedFilter _

                Action:=xlFilterCopy, _
                CriteriaRange:=.Range("AA1:AB2"), _
                CopyToRange:=C, _
                Unique:=False

 もうちょっと詳しく・・・
 エラーの内容と、「行をA3」の意味を。
 どこをどう変えました？
 （稲葉）

すみません、抽出された表をもう少し下に表示させたいのですが、できませんでした。

Sub 抽出()

    Dim F
    Dim D
    Dim XDay As Date
    Dim L As Range
    Dim C As Range

    Set L = Sheets("リスト").Range("A3:Z153 ")    'データの範囲　項目名を含んでください。"
    XDay = Range("A1").Value
    Range("A2:M100").ClearContents

    With Sheets("様式第2")
        For i = 0 To 2
            '抽出条件の項目名　リストの項目と一致させてください
            D = Split("申請日,変更通知日,額確定日", ",")

            '抽出する項目名、リストの項目と一致させてください
            F = Split("番号,申請日,住所,氏名,住宅種別,(ﾊ),(ﾆ),工事期間,(ﾎ),(ﾍ),(ﾄ),備考," & D(i), ",")

            Set C = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 3).Resize(, UBound(F, 1) + 1)
            C = F

            .Range("AA1:AB2") = D(i)
            .Range("AA2") = ">=" & XDay
            .Range("AB2") = "<=" & DateAdd("m", 1, XDay) - 1

            L.AdvancedFilter _
                Action:=xlFilterCopy, _
                CriteriaRange:=.Range("AA1:AB2"), _
                CopyToRange:=C, _
                Unique:=False
        Next i
        .Range("AA1:AB2").ClearContents
    End With
End Sub

 Set L = Sheets("リスト").Range("A3:Z153 ")    'データの範囲　項目名を含んでください。"
 ここは元データの範囲です。

 抽出データを下に移動させたいときは
 Range("A2:M100").ClearContents
       ~~~
 ここのA2をA3に替えて、
 適当な値をA2に入力しておいてください。

 【詳しい説明】
 Set C = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 3).Resize(, UBound(F, 1) + 1)
                      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ここの部分でやっているのは、A列の最終行を選択してCtrl+↑キーで止まったセルの行番号+3のセル
 をCに格納してください　という意味です。

 Range("A2:M100").ClearContents
 ここは、A2～M100の値を消してくださいという意味です。 
 なので、A3から消して、A2に何かしら入れておけば、A3から表が開始されます。
 （稲葉）

 あれ、+2が+3になってるの気がつかなかった・・・
 A1に日付、A2に何も入ってなければ、+2でA3から表示されると思うんだけど・・・
 （稲葉）

『抽出した範囲にはフィールド名がないか、または無効なフィールド名です。』と出て、
デバックを押すとこれが黄色表示されてしまいます(ToT)

L.AdvancedFilter _

                Action:=xlFilterCopy, _
                CriteriaRange:=.Range("AA1:AB2"), _
                CopyToRange:=C, _
                Unique:=False

（みなみ）

 １、↓このリスト範囲に項目名を含めていますか？
      Sheets("リスト").Range("A3:Z153 ")    
 ２、↑この範囲の「項目名」（フィールド名）と
      D = Split("申請日,変更通知日,額確定日", ",")
      F = Split("番号,申請日,住所,氏名,住宅種別,(ﾊ),(ﾆ),工事期間,(ﾎ),(ﾍ),(ﾄ),備考," & D(i), ",")
      ↑この「項目名」が完全に一致しているか確認してください。

 例えば(ﾊ)が（ハ）とか、額確定日が金額確定日など・・・

 （稲葉）

ためしにRange("A2:M100").ClearContentsの範囲広げて全項目入れてみましたが、同じエラーになりました(TOT)

項目は表示されましたが。。。

（みなみ）

 落ち着いてもう一度確認してもらえますか？

 ＞ためしにRange("A2:M100").ClearContentsの範囲広げて
 これは【抽出シート】のデータを一度消す範囲です。

 ＞全項目入れてみましたが、
 どこに入れましたか？
 一番最初の条件の時は動いたんですよね？

 試しに↓を動かしてください。
Sub 項目名出力()
    Dim L As Range
    Dim C As Range

    Set L = Sheets("リスト").Range("A3:Z3") 'リストの項目名範囲
    With Sheets("様式第2")
        Set C = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With
    Sheets.Add
    With ActiveSheet
        .Range("A1").Resize(, L.Columns.Count) = L.Value
        .Range("A2") = C.Address
    End With
End Sub
 新しいシートに元データの項目名が出力されますので、見られたくない項目名があればできませんが・・・
 出力されたデータをそのままここに貼り付けてもらえますか？
 （稲葉）

番号申請日住所氏名ﾌﾘｶﾞﾅ住宅種別階数住所住所氏名工事期間バリ安型省エネ型防災型その他型計交付決定日変更申請日バリ安型省エネ型防災型その他型計変更通知日額確定日
$A$1
これでいいでしょうか？

（みなみ）

 D = Split("申請日,変更通知日,額確定日", ",")
 F = Split("番号,申請日,住所,氏名,住宅種別,(ﾊ),(ﾆ),工事期間,(ﾎ),(ﾍ),(ﾄ),備考," & D(i), ",")
 ここの項目と一致しているか、もう一度確認してください。

 それと↓答えてください。

　＞全項目入れてみましたが、

 　どこに入れましたか？
 　一番最初の条件の時は動いたんですよね？
 （稲葉）

F = Split("番号,申請日,住所,氏名,住宅種別,(ﾊ),(ﾆ),工事期間,(ﾎ),(ﾍ),(ﾄ),備考," & D(i), ",")

ここに全項目を順番どおり入れてみました。

そうです、ただリストより報告用が項目が少ないのでいらない分を消したりしていたらおかしくなってしまいました(TOT)

 リストデータの項目が空白のところはありませんか？
 頂いたデータを見たところ、AからY列までしか有りませんでした。
 （変更されたリスト範囲はAからZ列）
 そこを直して、↓のデータでテストしたところ、問題なくできました。
 再度ご確認お願いします。

Sub 抽出()

    Dim F
    Dim D
    Dim XDay As Date
    Dim L As Range
    Dim C As Range

    Set L = Sheets("リスト").Range("A3:Y153")    'データの範囲　項目名を含んでください。
    XDay = Range("A1").Value
    Range("A2:M100").ClearContents
    D = Split("申請日,変更通知日,額確定日", ",")

    With Sheets("様式第2")
        For i = 0 To UBound(D, 1)
            F = Split("番号,申請日,住所,氏名,ﾌﾘｶﾞﾅ,住宅種別,階数,住所,住所,氏名,工事期間," & D(i), ",")

            Set C = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 2).Resize(, UBound(F, 1) + 1)
            C = F

            .Range("AA1:AB2") = D(i)
            .Range("AA2") = ">=" & XDay
            .Range("AB2") = "<=" & DateAdd("m", 1, XDay) - 1

            L.AdvancedFilter _
                Action:=xlFilterCopy, _
                CriteriaRange:=.Range("AA1:AB2"), _
                CopyToRange:=C, _
                Unique:=False
        Next i
        .Range("AA1:AB2").ClearContents
    End With
End Sub
13:30　コードの一部変更しました。
 （稲葉）

できました！
何度も何度も申し訳ありません。

あの最後にもうひとつだけ、しばらくはないと思うのですが、様式に若干の変更があった場合
どのように中を帰ればいいのでしょうか？
たとえば項目が２段書き、結合したセルの下に複数の項目とか今３段表示で抽出しているのを４段に変更と
なった場合はどこをいじればいいんでしょうか？

（みなみ）

 ＞たとえば項目が２段書き、結合したセルの下に複数の項目
 行方向の結合（A1:A2の結合等）では使えません
 列方向の結合（A1:B1の結合で、詳細項目がA2・B2で単独）の場合、以下のようにしてください。

 Set L = Sheets("リスト").Range("A3:Y153")
                                ~~~~~~~~
 波線の部分を結合されてない項目に変更する。

 ＞今３段表示で抽出しているのを４段に変更となった場合はどこをいじればいいんでしょうか？ 
 13:30に↑↑のコードを差し替えました。
 差し替えたコードの
 D = Split("申請日,変更通知日,額確定日", ",")
           ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ここの項目をカンマ「,」区切りで増やすことで、3段、4段に自動で変わります。

 （稲葉）

ありがとうございます。

試してみたのですが、列方向の結合の項目は別名で下の詳細項目が同じ名前だと
１つ分を２回抽出したようになってしまいました。
名前はかえないとだめでしょうか？

（みなみ）

 ごめんなさい、よくわからないです・・・

 例えばどういうものですか？
 0│    A        B        C        D    │
 1│　　　　　型　　　　　　式　　　　　│
 2│バリ安型│省エネ型│防災型│その他型│ 
 3│　○　　│　　　　│　　　│　○　　│

 こういうデータがあったとして、データ範囲は
 A2:D3
  ~
 ↑結合セルは含んでいませんよね？
 （稲葉）

すみません。

こんな感じです。

　　　　A　　　B　　　　C　　D
1｜　申請者　　｜　施工者　　｜
2｜住所｜氏名｜住所｜氏名｜
3｜○×｜□■｜▽▲｜☆★｜

この場合、申請者のデータだけ抽出されてしまいます。

範囲は2行目から指定しています。

For i = 0 To UBound(D, 1)

            F = Split("番号,申請日,住所,氏名,住所,氏名,工事期間," & D(i), ",")

 なるほど
 項目名は一意（ユニーク）じゃないと一番最初に見つかった項目名しか引っ張れない
 ですね。（たぶん、詳しく検証したわけじゃないですが）

 そうなりますと、
 新しくコードを組み直すか、
 項目名をそれぞれ別にしてもらうしかないです。

 小技ですが・・・
 0   A     B     C     D 
 1｜　申請者　｜　施工者　｜ 
 2｜住所｜氏名｜住所｜氏名｜
 3｜申住｜申名｜施住｜施名｜　←この行を隠す
 4｜○×｜□■｜▽▲｜☆★｜

 とか・・・

 ちなみに新しいコードになると、私の手に負えないかも・・・
 （稲葉）

こんにちは。

前に他の人が関数で作った全く違う様式で受付け月と、作業日で抽出する関数で動くのがあったのでそれをつかって何とか作ってみました(^o^;

申請日,変更通知日,額確定日にそれぞれ月ごとにカウントできる番号を自動作成、関数はこんな感じです。

=IF(D4="","",TEXT(D4,"geemm")&TEXT(COUNTIF($D$2:D4,"<"&DATE(YEAR(D4),MONTH(D4)+1,1))-COUNTIF($D$2:D4,"<="&(D4-DAY(D4))),"-00"))

これは申請日のセルを参照していて、結果は、たとえはH25.7.1ならばH2507-01、２番目もH25.7.1でもH2507-02と表示されてこの番号を参照して抽出シートに抽出するというものでした。

【項目『番号』のセルの関数式】
=IF(ISERROR(IF(VLOOKUP(TEXT($A$1,"gemm")&TEXT(ROW(A1),"-00"),リスト!$A$4:$AB$153,3,FALSE)=0,"",VLOOKUP(TEXT($A$1,"gemm")&TEXT(ROW(A1),"-00"),リスト!$A$4:$AB$153,3,FALSE))),"",IF(VLOOKUP(TEXT($A$1,"gemm")&TEXT(ROW(A1),"-00"),リスト!$A$4:$AB$153,3,FALSE)=0,"",VLOOKUP(TEXT($A$1,"gemm")&TEXT(ROW(A1),"-00"),リスト!$A$4:$AB$153,3,FALSE)))

受付け番号は通し番号なので、後の項目はVLOOKUP関数で抽出する形で何とかできました。

報告遅くなり申し訳ありませんでした。

（みなみ）

コメント返信：

[ 一覧(最新更新順) ]

[[20130627083141]] 『リストから受付月ごとに抽出』（みなみ） ページの最後に飛ぶ

[[20130627083141]]　『リストから受付月ごとに抽出』（みなみ）　ページの最後に飛ぶ