[[20160711100348]] 『複数のシートから該当する行だけを抽出したい』(ak) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数のシートから該当する行だけを抽出したい』(ak)

複数のシートから該当する行だけを抽出することは可能でしょうか。

日々記入するシート(例6/1)

   2 3 4 5        6

  記載日   記入者  クライエント    対応内容     所感

7  6/7    A    ○田様     〜〜について   Aとしては〜

8  6/7    B    ☆山様     ××の確認    この際の〜

これを集約シートに
  
    2     3   
2  対象者   ○田様

   記載日   記入者  クライエント   対応内容     所感

6  4/5     D    ○田様     ○の対応    今回…
7  5/8     B    ○田様     ×の対応    Bからすると
8  6/7     A    ○田様     〜について   Aとしては

という風に名前を入力するだけで該当する行を抜き出せるようにしたいと考えています。
一つのシートから抽出する方法は見つかったのですが、複数のシートから抽出する方法が見つかりませんでした。

よい方法があれば教えてください。
よろしくお願い致します。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


1つのシートから抽出するコードが既にあるならば、シート名が違うだけのまったく同じコードを作成し、両方実行する、というのが一番簡単かと。
(???) 2016/07/11(月) 10:53

アドバイスありがとうございます!

見つけたのはリストになっているものから関数を使って抜き出すやり方でした。

ただそうすると、
・日誌の形式でシートを作っていて、レイアウトがただのリスト形式ではないこと
・毎日日誌のシートを増やしてしていくので、そのやり方だと結局日誌のシートを一日分ずつ探していくのと変わ らないこと
があり、今回質問させて頂きました。

シートを増やしても、全てのシートを検索し抽出できる方法は難しいのでしょうか?
(sk) 2016/07/11(月) 12:01


ありゃ、関数ということは、数式でしょうか。数式だと、相手がバラバラだと難しいですねぇ。
1つ目のシートで該当が何件あるかによって、2つ目のシートの抽出先が変わってきますから。

名前を入力後、ActiveXのボタンを押すと、マクロで一覧作成する、というのが簡単かと思いますよ。
そういう例を探してみてください。(よくある処理です)
(???) 2016/07/11(月) 13:10


作業列を使えばそんなに複雑にはならないように思います。

質問1
 「日々記入するシート」のシート名には規則性がありますか?
  具体的なシート名を書き入れてください。

質問2
 集約シートに「日々記入するシート」の個数だけの列数を作業列として
 確保できますか?

私はこれから出かけますのですぐには対応できませんが
これだけの情報が明らかになれば回答をいただけると思います・・・

(メジロ) 2016/07/11(月) 13:56


 関数処理でもいいのでしょうが、本件、機能的にはフィルターオプションを使いたくなるテーマです。
 ただし、フィルターオプションは基本的に 1枚の元ネタシートから、条件によってデータを抽出して、別シートに転記になります。

 今回のように、

 ・抽出元シートは複数。
 ・抽出先では、それぞれのシートから抽出したものを順次、追加していく。

 という要件ですと、

 1.複数の抽出元シートのデータを1枚の作業シートにコピペしながらまとめ、その1枚になった元ネタから
   フィルターオプションで、抽出先シートに抽出。

 あるいは

 2.複数の抽出元シートから、シート毎に、フィルターオプションで抽出先シートの末尾に抽出し、
   2枚目のシートからは、その際に、一緒にコピーされるタイトル行を削除していく。

 こんな流れになります。
 1.でしたら、操作としても、(2.に比べて)そんなに手間はかからないと思いますが、ご希望なら、この操作手順を
 マクロ記録して、そのマクロを使うという方法がいいかもしれません。

(β) 2016/07/11(月) 14:23


メジロさん、βさんありがとうございます!

メジロさん

質問1.シート名は6.1のように日付をその日ごとに記入する予定です。

質問2.列として今のところ、年度の分で作成する予定でしたが、月ごとなどで分ければ作業列の確保もでき    ると思います。答えになっていなかったらすみません…

βさん
そのような方法もあるんですね。
ただ、日々記入するシートはほぼ毎日更新します。コピペの方法だと、結局毎日集計用シートに記入したものをコピペする方法と変わらないような気がして、もう少し便利な方法を探していたところです。

知識や説明が足りず申し訳ありません。

過去の[[20100614113853]] の方法が今回の投稿と近いのではと思ったのですが、どこを修正して活用すればよいかわかりませんでした。こちらについてもご意見が伺えればと思います。

よろしくお願いいたします。
(ak) 2016/07/11(月) 16:22


 たとえば 集約シート以外が全て以下のようなレイアウト。

     |[B]    |[C]   |[D]          |[E]     |[F] 
 [6] |記載日 |記入者|クライアント |対応内容|所感
 [7] |6月5日 |A     |aaa商会      |yyyyy1  |zzz1
 [8] |6月7日 |B     |bbb商店      |yyyyy2  |zzz2
 [9] |6月7日 |C     |aaa商会      |yyyyy3  |zzz3
 [10]|6月10日|D     |xyzカンパニー|yyyyy4  |zzz4
 [11]|6月11日|A     |bbb商店      |yyyyy5  |zzz5
 [12]|6月12日|B     |aaa商会      |yyyyy6  |zzz6
 [13]|6月20日|C     |xyzカンパニー|yyyyy7  |zzz7
 [14]|6月25日|D     |aaa商会      |yyyyy8  |zzz8
 [15]|6月25日|A     |bbb商店      |yyyyy9  |zzz9

 集約シートは、フィルターオプション用に少しレイアウトを変更して以下のようにします。

    |[B]         |[C]   |[D]         |[E]     |[F] 
 [2]|クライアント|      |            |        |    
 [3]|aaa商会     |      |            |        |    
 [4]|            |      |            |        |    
 [5]|            |      |            |        |    
 [6]|            |      |            |        |    
 [7]|記載日      |記入者|クライアント|対応内容|所感

 標準モジュールに

 Sub Sample()
    Dim shT As Worksheet
    Dim shF As Worksheet
    Dim x As Long
    Dim done As Boolean
    Dim r As Range

    Application.ScreenUpdating = False

    Set shT = Sheets("集約")
    With shT.Range("A1", shT.UsedRange)
        x = .Columns.Count + 2
    End With

    For Each shF In Worksheets
        If shF.Name <> shT.Name Then    '集約シートは除外
            Set r = shF.Range("B6", shF.Range("B" & Rows.Count).End(xlUp)).Resize(, 5)
            If done Then Set r = r.Offset(1).Resize(r.Rows.Count - 1)
            r.Copy shT.Cells(Rows.Count, x).End(xlUp).Offset(1)
            done = True
        End If
    Next

    shT.Cells(2, x).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        criteriaRange:=shT.Range("B2:B3"), CopyToRange:=shT.Range("B7:F7"), Unique:=False

    shT.Cells(2, x).CurrentRegion.Clear

 End Sub

(β) 2016/07/11(月) 18:08


βさん

ありがとうございます。

日々記入するシートは表だけではなく
日時や連絡事項の欄があり、その中に上記の表を組み込んでいる形になります。

それでも、βさんの記入していただいたマクロは使用できるのでしょうか?

(ak) 2016/07/11(月) 18:18


 >>それでも、βさんの記入していただいたマクロは使用できるのでしょうか? 

 シートの B列の入力データ最終行の 下に、それらの項目がなければOKです。

 もし、それらが B列にかかっていた場合は、データとの間に、空白行があれば

 Set r = shF.Range("B6", shF.Range("B" & Rows.Count).End(xlUp)).Resize(, 5) を

 Set r = shF.Range("B6", shF.Range("B6").End(xlDown)).Resize(, 5) に変えればOKになります。

(β) 2016/07/11(月) 18:56


βさん
何度も丁寧にありがとうございます。

今作成しているシートを確認したところ、
19行に記載日などの項目
A20〜A27に抽出するための行で列はEまで使用していました。

また、26行から32行までに引継ぎ事項
33から35行に確認印の欄を作成予定です。

この場合は同じように作成して大丈夫でしょうか?

初歩的なことを何度も聞いてしまいすみません。

よろしくお願いいたします。
(ak) 2016/07/11(月) 19:34


 >>今作成しているシートを確認したところ、 
 >>19行に記載日などの項目 
 >>A20〜A27に抽出するための行で列はEまで使用していました。 

 まず、集約シートのことですか、それとも、集約以外のシートのことですか?

 集約以外のシートだとして、そちらの最初の説明を元に、(β) 2016/07/11(月) 18:08 で整理してアップしたレイアウトは
 タイトル行が 6行目になっているわけですけど、それが 19行目だったということですか?
 それと、 A20〜A27 で、E列まで ということは、説明は B列〜F列でしたけど、本当は、A列〜E列 ということですか?

 >>また、26行から32行までに引継ぎ事項 
 >>33から35行に確認印の欄を作成予定です。 

 列が問題になります。データの列とは離れた右のほうならいいのですが。
 26行目というとデータ行と同じになりますから、データ領域とは離れた右のほうですね?

 いずれにしても、コードは B〜F を前提としたコードですので、A〜E なら、当然、そこは変更が必要です。
 (仮に、回答が数式によるものだったとしても、レイアウトが変更になれば、そのままの式ではだめなのと同じです)

(β) 2016/07/11(月) 19:49


βさん

説明がつたなくてすみません。

話していたのは集約以外のシートについてです。
表自体のタイトルは19行目です。

また、項目はB〜F列で大丈夫でした。
引継ぎ事項などはA28行以下に記載でした。

すみません。
(ak) 2016/07/11(月) 20:29


 >>引継ぎ事項などはA28行以下に記載でした。 

 列が重要だと何度かコメントしています。
 データが27行目まであるとして そのすぐ下の28行目から引き継ぎ事項があるとしたら
 データと連続していて、どこまでがデータか、どこから引き継ぎ事項か、判断ができませんよね。

 引き継ぎ事項等はどの列に書いてあるのですか?

(β) 2016/07/11(月) 21:15


βさん

何度もすみません。

引継ぎ事項はB列〜F列を結合して使用しています。

タイトルがA28行でB列〜F列を結合して
その下はA29〜32、B列〜F列を結合で記入欄を作成しています。

これで説明が足りるでしょうか…。
すみません。
(ak) 2016/07/11(月) 22:22


 う〜ん・・・

 じゃぁ、以下のレイアウトですか?

     |[B]       |[C]   |[D]          |[E]     |[F] 
 [19]|記載日    |記入者|クライアント |対応内容|所感
 [20]|6月5日    |A     |aaa商会      |yyyyy1  |zzz1
 [21]|6月7日    |B     |bbb商店      |yyyyy2  |zzz2
 [22]|6月7日    |C     |aaa商会      |yyyyy3  |zzz3
 [23]|6月10日   |D     |xyzカンパニー|yyyyy4  |zzz4
 [24]|6月11日   |A     |bbb商店      |yyyyy5  |zzz5
 [25]|6月12日   |B     |aaa商会      |yyyyy6  |zzz6
 [26]|6月20日   |C     |xyzカンパニー|yyyyy7  |zzz7
 [27]|6月25日   |D     |aaa商会      |yyyyy8  |zzz8
 [28]|引継ぎ事項                     |   
 [29]|あああああ                     |     
 [30]|いいいいい                     | 
 [31]|ううううう                     |  
 [32]|えええええ                     |  

 で、集約シートに集めるのは各シートの20行目〜27行目に固定(最大でも8行)ということですね?

(β) 2016/07/11(月) 22:50


 ↑ 上記だとして。

 Sub Sample2()
    Dim shT As Worksheet
    Dim shF As Worksheet
    Dim x As Long
    Dim done As Boolean
    Dim r As Range

    Application.ScreenUpdating = False

    Set shT = Sheets("集約")
    With shT.Range("A1", shT.UsedRange)
        x = .Columns.Count + 2
    End With

    For Each shF In Worksheets
        If shF.Name <> shT.Name Then    '集約シートは除外
            Set r = shF.Range("B19:F27")
            If done Then Set r = r.Offset(1).Resize(r.Rows.Count - 1)
            r.Copy shT.Cells(Rows.Count, x).End(xlUp).Offset(1)
            done = True
        End If
    Next

    shT.Cells(2, x).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        criteriaRange:=shT.Range("B2:B3"), CopyToRange:=shT.Range("B7:F7"), Unique:=False

    shT.Cells(2, x).CurrentRegion.Clear

 End Sub

(β) 2016/07/11(月) 22:55


 ↑と全く同じ処理ですが

 >>前を入力するだけで該当する行を抜き出せるようにしたい

 ということですので、集約シートのシートモジュール(シートタブを右クリックして、コードの表示を選ぶとでてくるところ)に
 以下を貼り付けてください。

 集約シートの B3 に 抽出すべき顧客名を入力すれば自動的に抽出してセットします。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim shF As Worksheet
    Dim x As Long
    Dim done As Boolean
    Dim r As Range

    If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    With Range("A1", UsedRange)
        x = .Columns.Count + 2
    End With

    For Each shF In Worksheets
        If shF.Name <> Me.Name Then    '集約シートは除外
            Set r = shF.Range("B19:F27")
            If done Then Set r = r.Offset(1).Resize(r.Rows.Count - 1)
            r.Copy Cells(Rows.Count, x).End(xlUp).Offset(1)
            done = True
        End If
    Next

    Cells(2, x).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        criteriaRange:=Range("B2:B3"), CopyToRange:=Range("B7:F7"), Unique:=False

    Cells(2, x).CurrentRegion.Clear
    Application.EnableEvents = True

 End Sub

(β) 2016/07/11(月) 23:05


マクロに重点が行っているように思いますが、関数で抽出するために質問をしましたので
関数での方法です。

前提条件
 1.シート名の日の部分は必ず2桁にします。
   6.1 → 6.01
 2.式が長く煩雑になりますので、いくつか作業列(セルも)を使います。

      作業列の列などは仮ですので適当な場所に設けてください。
 3.準備した「日々記入するシート」は「4.05、5.08、6.02、6.07」の4日間です。
 4.「日々記入するシート」の行数は「1000行未満」と仮定しました。

手順1 日付のシートをグループ化して次の式を入力します。

  H5: =MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,5)

    H7: =IF(OR(C7="",C7<>集計!$B$2),"",$H$5*100+ROW(A1)/1000)
      必要数、下にコピーします。

手順2 集計シートを選択して、次の式を入力します。(作業グループが解除されたことを確認)

  G6: =IFERROR(SMALL('4.05:6.07'!$H$7:$H$26,ROW(A1)),"")

      必要数、下にコピーします。

  A6: =IFERROR(INDEX(INDIRECT("'"&INT($G6)/100&"'!$A$7:$E$100"),ROUND(MOD($G6,1)*1000,0),COLUMN(A1)),"")
   右と下にコピーします。

(メジロ) 2016/07/12(火) 08:11


βさん、メジロさん

丁寧に教えてくださってありがとうございます。

お二人に教えていただいた方法で試してみます!

試してみて、うまくいかないところがあれば
また質問させてください!

ありがとうございました!
(ak) 2016/07/12(火) 10:54


βさん

お世話になっています。

教えて頂いたマクロを入力しました!

その際にコンパイルエラーで 修正候補がステートメントの最後となり

集約シートの B3 に 抽出すべき顧客名を入力すれば自動的に抽出してセットします。

の「に」の部分が赤くなるのですがどの様に修正すればよいでしょうか?
(ak) 2016/07/13(水) 12:42


メジロさん

お世話になっています。

関数での抽出も試してみたいのですが、

手順1の質問
メジロさんの関数のなかのH5、H7、作業列として使っているということなのでしょうか。
作業列を記入している欄の横のF20欄を使用したいと考えています。その際は上の2つのセルをF20、F21に変えれば大丈夫でしょうか。

手順2の質問
二つの式がそれぞれどのような結果を出すために入力している式なのかを教えて頂けると、イメージがしやすいのですが、教えて頂けたら幸いです。

お手数をおかけして申し訳ありません。
よろしくお願い致します。

(ak) 2016/07/13(水) 12:52


手順1の質問 「作業列の列などは仮ですので適当な場所に設けてください」と書きましたように
場所(セル)は任意ですのでF列でも構いません。
ただ私のほうからはakさんの表がどのように作られているかがわかりません。
「作業列を記入している欄の横のF20欄を使用したい」この部分は理解できません?
一番初めの書き込みから素直に行列番号を推測して式を書き込んでいます。
できれば次のように書きこまれると解決が早まると思います。

    A    B    C    D    E  ←番号

 1
 2
 3
↑行番号

手順2の質問

G6: =IFERROR(SMALL('4.05:6.07'!$H$7:$H$26,ROW(A1)),"")
 この式は指定した対象者のデータがあるシートと行を求める式です。
 「405.002」と計算結果が求まると
  405 はシート「4.05」を表し
  .002 は7行目を基準とした「2行目」を表しています。

A6: =IFERROR(INDEX(INDIRECT("'"&INT($G6)/100&"'!$A$7:$E$100"),ROUND(MOD($G6,1)*1000,0),COLUMN(A1)),"")
この式はG列の計算結果から該当するシートの該当する行から「記載日、記入者、クライエント、対応内容、
所感」を取りだします。
(メジロ) 2016/07/13(水) 14:03


 >>その際にコンパイルエラーで 修正候補がステートメントの最後となり 
 >>集約シートの B3 に 抽出すべき顧客名を入力すれば自動的に抽出してセットします。 
 >>の「に」の部分が赤くなるのですがどの様に修正すればよいでしょうか?

 シートモジュールに貼り付けるのは

 Private Sub Worksheet_Change(ByVal Target As Range)

 このコードから

 End Sub

 このコードまでです。

 「集約シートの B3 に 抽出すべき顧客名を入力すれば自動的に抽出してセットします。」

 ここは、私の「コメント」の一部です。

(β) 2016/07/13(水) 14:55


βさん

何度もすみません。

名前を入れて実行しましたところ

エラー1004がでました。
フィールド名がないか無効なフィールドの表記でした。

デバッグモードでは
Cells(2, x).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _

        criteriaRange:=Range("B2:B3"), CopyToRange:=Range("B7:F7"), Unique:=False
が黄色くなっていました。

シートを見ると
R2〜V2にタイトル行が出て、書いている記録が全て抽出された形になりました。

どの様に修正すればよいでしょうか
(ak) 2016/07/13(水) 15:32


 集約シートに関しては (β) 2016/07/11(月) 18:08 で提示したレイアウト、
 集約シート以外に関しては (β) 2016/07/11(月) 22:50 で提示したレイアウトになっていますか?

 とくに、集約シートの B2 と D2 、集約シート以外のシートの D19 は、同じ値がはいっていますか?
 (私がアップしたサンプルでは クライアント、そちらのサンプルは クライエント。いずれでもいいのですが同じ文字列であることが必要)

(β) 2016/07/13(水) 16:14


 >>R2〜V2にタイトル行が出て、書いている記録が全て抽出された形になりました。 

 列が R列〜になっているのがちょっと気になります。
 今度、試す前に 集約シートの G列から右はクリアしておいてくださいね。

(β) 2016/07/13(水) 16:16


βさん

何度もすみません。

マクロを見て、自分なりに少し範囲などを変えてみたのですが反映されませんでした。

Set r = shF.Range("B19:F27")のところを Set r = shF.Range("A9:F16")

CopyToRange:=Range("B7:F7"), Unique:=False

CopyToRange:=Range("A9:E9"), Unique:=False

に変えてみました。

そうしたところ実行すると
1行目だけは抽出されたのですが、抽出されたものや記入されていない空欄部分も含めた行が
O列からS列にすべてコピーされていました。

集約シートは同じような書式に変えたのですが、抽出されないようです。

 Cells(2, x).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
    criteriaRange:=Range("B2:B3"), CopyToRange:=Range("A9:E9"), Unique:=False

の部分がどの様な動作を指示しているのか、criteriaRangeがこのマクロではどの様な役割になっているかをお伺いしてもよろしいでしょうか。

何度もお手数をかけてしまって申し訳ありませんが教えてください。
よろしくお願い致します。

(ak) 2016/07/14(木) 17:41


 以前は 

 >>R2〜V2にタイトル行が出て

 今回は

 >>O列からS列にすべてコピーされていました

 ここは、少し気になるところですが後回しにします。

 1.まず、集約シート以外のシートのB19:F27の値を、集約シートのH列より右の5列に、上詰めにすべて転記します。
  (R〜V になったり O〜Sになったりしていますが、それは後に回します)

 2.この1つにまとめられた全データが抽出元のリストになります。
  これが Cells(2, x).CurrentRegion.AdvancedFilter のところの Cells(2, x).CurrentRegion です。

 3.で、このリストから抜き出す条件が 集約シートの B2:B3 に記載されているという前提です。
  つまり、B2 が抜き出すべき列タイトル文字列。B3には抜き出すべき顧客名。
  これが criteriaRange:=Range("B2:B3") です。

 4.2.から3.の条件で抜き出したものを 集約シートの B7:F7 に転記します。
  B7:F7には抽出データをどのように配置するかのタイトル文字列が書かれています。
  つまり 記載日、記入者、クライアント、対応内容、所感 で、2.の領域の当該のタイトル行列で抽出条件に合うものを
  B8:F8以降に転記します。
  これが、CopyToRange:=Range("B7:F7") です。

 次に、疑問なんですけど

 >>Set r = shF.Range("B19:F27")のところを Set r = shF.Range("A9:F16") 

 集約シート以外のシートレイアウト、そちらの説明が、たびたびかわるので、最終的には (β) 2016/07/11(月) 22:50 で
 タイトルは、B19:F19、データは 20行目からの B20:F27 、つまり、タイトル行含めたリスト領域は B19:F27 として、
 確認をお願いし、特段の否定もなかったので、このレイアウトだと そう理解しています。 

 ここで、なぜ 「A9:F16」が登場してくるのですか?

 本当のレイアウトはどうなっているのですか?

 >>CopyToRange:=Range("B7:F7"), Unique:=False 
 >>を 
 >>CopyToRange:=Range("A9:E9"), Unique:=False 

 なぜ、こう変えてみたのか、その意図がわかりませんが、 A9:E9 って、どんな領域なんですか?
 ここは、あくまで集約シート上で、最終的に抽出データを転記する最初の行(つまり 抽出タイトル行)なんですが?

(β) 2016/07/14(木) 18:50


βさん

説明が足りずご迷惑をおかけしました。申し訳ありません。

集約シート以外のシートですが、都度レイアウトを見直している状況でたびたび変更していました。

集約シートですが

    A      B       C       D      E  

 1     タイトル(2行、E列で結合)
 2
 3   日付            ●月●日   曜日
 4   事業実施状況(タイトル)
 5   事業実施状況(記載欄:E列まで結合)
 6   参加状況(タイトル)   参加者数    ●名
 7   参加状況(記載欄:E列まで結合)
 8  日付    記入者    クライエント  対応内容   所感(抽出希望データタイトル行)
 9  記入欄1
 10  記入欄2
 11  記入欄3
 12  記入欄4
 13  記入欄5
 14  記入欄6
 15  記入欄7
 16  記入欄8
 17  引継ぎ事項(タイトル:E列まで結合)
 18   引継ぎ事項記入欄(E列まで結合)
 19  (空き)
 20  確認印(E列まで結合)

が最終的なものです。

集約シートに関しては特に記入などはしていませんでした。

変更した点に関してですが
Set r = shF.Range("B19:F27")をタイトル行の範囲と思い
Set r = shF.Range("A9:F16") と入力しましたが、まずこの時点で行数を見間違えていました。
また、

CopyToRange:=Range("B7:F7"), Unique:=False の部分を日々記入するシートのコピーする範囲だと考え 今回の書式の記入欄1〜8の枠のCopyToRange:=Range("A9:E9"), Unique:=Falseと変更し入力いたしました。

何度もご迷惑をお掛けしていることは承知の上ですが
もし、今の状況でアドバイスを頂けるなら、非常に心強いです。
(ak) 2016/07/14(木) 20:51


 集約シート以外の最終レイアウト了解。

 それでは、まず コードを以下で入れ替え。(わかりやすくするために、領域指定をできるだけ固定にしてあります)

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim shF As Worksheet
    Dim x As Long
    Dim done As Boolean
    Dim r As Range

    '抽出顧客欄の変更以外は処理しない
    If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub

    '無駄なイベント発生の抑止
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Columns("G:M").ClearContents                    '作業域クリア
    Range("A1", UsedRange).Offset(3).ClearContents  '抽出領域クリア

    If IsEmpty(Range("B2")) Then Exit Sub           '指定顧客が空白なら処理せず

    For Each shF In Worksheets
        If shF.Name <> Me.Name Then     '集約シートは除外
            If Not done Then            '最初のシートのみ
                Range("H1:L1").Value = shF.Range("A8:E8").Value '作業域タイトル
                Range("B7:F7").Value = shF.Range("A8:E8").Value '抽出域タイトル
            End If
            Set r = shF.Range("A9:E16") '抽出位元シートのデータ領域(除くタイトル行)
            r.Copy Range("H" & Rows.Count).End(xlUp).Offset(1)  '集約シートの作業域に追加
            done = True
        End If
    Next

    'フィルターオプションによる抽出
    Range("H1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        criteriaRange:=Range("B2:B3"), CopyToRange:=Range("B7:F7"), Unique:=False
    '作業域クリア
    Range("H1").CurrentRegion.Clear
    'イベント発生再開
    Application.EnableEvents = True

 End Sub

 で、集約シートは、

 B2 に "クライエント" と入れておいてください。そのほかは空白でOKです。
 この状態で、B3 に 顧客名を入力してみてください。

 ★テーマとは関係ありませんが、タイトル、そちらでは "クライエント" を使っているようですね。
  本来は、商取引の顧客ですから "クライアント"が一般的だと思いますが。
  "クライエント"は、主に、心療コンサルを受ける患者という場合に(日本では)使い分けをしているようで須。
  (英語では、どちらも同じ Client ですが)

(β) 2016/07/14(木) 21:42


βさん

本当にありがとうございます!

マクロを入力し実行してみました。

その結果、B7列からF7列にタイトル行がコピーされました。
エラーなどは出ていなかったのですが、各シートの記載部分はコピーされませんでした。

この場合、どのように処理を行えばよいでしょうか?
(ak) 2016/07/15(金) 09:56


βさん

すみません再度入力した結果、無事抽出されました!

何度もご迷惑をお掛けしましたが
本当にありがとうございました!!

(ak) 2016/07/15(金) 12:01


先日はありがとうございました!

このシートを使用していて、聞きたいことができたのでまたご連絡させて頂きました。

日々記入するシートをの日付の列(A列)を非表示にした場合、抽出するときに非表示にしたA列も抽出することは可能でしょうか?

聞いてばかりですみません。

よろしくお願い致します。
(ak) 2016/07/19(火) 13:58


 >>日々記入するシートをの日付の列(A列)を非表示にした場合、抽出するときに非表示にしたA列も抽出することは可能でしょうか?

 まず、やってみてはいかがでしょうか。

(β) 2016/07/19(火) 16:32


非表示だと問題があるのでしたら、マクロ内で処理前に再表示し、処理後に非表示に戻してはいかがでしょうか。
(???) 2016/07/19(火) 16:39

皆さま

色々とアドバイスありがとうございます。

印刷した際の見やすさを考え、非表示のまま日々のシートを増やしたいと考えていました。

非表示にした状態でマクロを実行するとそのシートの情報が抽出されなかったため、今回質問いたしました。
難しそうならそのまま使用しようと思います。

(ak) 2016/07/19(火) 17:47


 >>非表示にした状態でマクロを実行するとそのシートの情報が抽出されなかったため

 そうですか?
 こちらで、集約シート以外の A列をすべて非表示にして実行。
 表示状態とかわらず、記載日列も含めてきちんと集約シートに抽出されていますが?

 ちょっと気になるのは、(ak) 2016/07/15(金) 09:56 では抽出されなかった。でもコードはそのままで
 もう一度やると (ak) 2016/07/15(金) 12:01 の報告の通り抽出された。

 この違いは何でしたか?

(β) 2016/07/19(火) 18:04


 もう1つ気になります。

 >>印刷した際の見やすさを考え、非表示のまま日々のシートを増やしたいと考えていました。

 印刷するのは集約シートではないのですか?
 日々のシートを印刷するのですか?(だから、だめということではないですが)

 で、日々のシートの非表示にしたA列って、記載日列ですね?

(β) 2016/07/19(火) 18:14


βさん

他の職員からフィードバックをもらうために日々のシートを印刷して綴ろうとしています。

そうです。記載日の列です。
(ak) 2016/07/19(火) 19:15


 A列が記載日列、了解。

 で、(β) 2016/07/19(火) 18:04 のレスに対してはいかがですか?

 いずれにしても、こちらではちゃんと抽出されていますので、これ以上は何とも・・・
 同じブックで A列を表示させた状態で実行すると抽出されるということですね?

(β) 2016/07/19(火) 21:12


βさん

やり直した際は、集約シートのクライアント表記が少し違っていたのでマクロが上手くいかなかっただけでした。

そうなんです。明日の午前中に再度確認してマクロ試してみます。

いつも丁寧にありがとうございます。
(ak) 2016/07/19(火) 22:23


βさん

今、マクロを再度行ったら無事に抽出できました。
お騒がせしてすみません。

このマクロで本当に仕事が楽になりました!
本当にありがとうございました
(ak) 2016/07/20(水) 09:40


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.