[[20180315234918]]　『結合部分をフィルター』（まゆ）　ページの最後に飛ぶ

『結合部分をフィルター』（まゆ）

 はじめましてまゆと申します。
 フィルターを結合していると結合している1行しか表示されないのでネットで色々と調べていたらこのサイトに辿り着きました。
 結合しているフィルタを表示させるにはどのようにしたら良いのでしょうか？
 任意のセルをコピーして数式で貼り付けるなどの作業ですと手間がかかり効率が良くなりませんでしたので他に方法はありますでしょうか？
 コピーペーストなどをしないのが一番ですがどなたか押していただけないでしょうか宜しくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 ＞任意のセルをコピーして数式で貼り付けるなどの作業ですと手間がかかり効率が良くなりませんでした

 効率化となると、その作業(に近いこと）をマクロでやるぐらいじゃないですか？

 抽出が済んだあと、どういう状態にするんですか？
 　常識的には大元の状況(結合セル中、２番目以降のセルは空白）に戻すのでしょうが、
 　ちょっと面倒だなぁ、と言う気がしているんですけど。

 　初めに大元シートを別シートにコピーして、そこで上記作業と抽出をやり、
 　終わったら、その別シートを削除した方がマクロの手間としても減るし、
   完璧に元の状態になれる(当たり前ですけど、結構、これ大事）

（半平太） 2018/03/16(金) 10:31

単に表示させればというなら、
先日マナさんから教えていただいたフィルターオプションと組み合わせれば出来るんじゃないでしょうか。
手作業でもできます。
参考例です。新しいBookでお試しください。

Sub test()

    'a項の2をフィルター表示
    Application.DisplayAlerts = False
    Cells.UnMerge
    Cells.Clear
    Range("A1:D1").Value = Array("a項", "b項", "c項", "d項")
    Range("A2:D2").Value = Array("1", "b1", "c1", "d1")
    Range("A2:D2").AutoFill Range("A2:D12"), xlFillDefault
    Range("A3:A4").Merge
    Range("A5:A6").Merge
    Range("A7:A8").Merge
    Range("D3:D4").Merge
    Range("D5:D6").Merge
    Range("D7:D8").Merge
    Range("A7").Value = 2
    Range("A10").Value = 2
'実作業はここからです
    Range("G2").Formula = "=OR(A2=2,A1=2)"
    Range("A1:D12").AdvancedFilter xlFilterCopy, Range("G1:G2"), Range("I1"), False
    Range("I1").CurrentRegion.AutoFilter Field:=1, Criteria1:="=2", _
        Operator:=xlOr, Criteria2:="="
End Sub

（kazuo） 2018/03/16(金) 11:38

 作業列一つ(B列)を使って対象列(A列)に数式貼り付けしていくのとか

 Sub Macrox()

 Dim row1 As Long, i As Long

 row1 = Cells(Rows.count, "A").End(xlUp).Row

 For i = 2 To row1

    Range("B" & i) = "=A" & i
    Range("B" & i).Copy
    Range("B" & i).PasteSpecial Paste:=xlPasteValues
    Range("B" & i).Copy
    Range("A" & i).PasteSpecial Paste:=xlPasteFormulas
    Range("B" & i).ClearContents

 Next i

 End Sub

 にしてもこんなんできたんですねｗｗデータに結合セル使うなんてことしないんで知りませんでした。
 見るからに怪しいですけどなんか弊害ってあったりするんですかね？あとExcelの仕様変更で簡単にダメになりそう・・・
（774） 2018/03/16(金) 11:52

kazuoさん

＞Range("G2").Formula = "=OR(A2=2,A1=2)"

１レコード目は抽出できないようです。

'-----
774さんのアイデアと同じなのですが、
βさんがときどき使ってましたね。

例えば、↓

[[20150331163557]]　『フィルター後の行の高さについて』（りりこ）

（マナ） 2018/03/16(金) 20:01

マナ先生すみません。付け刃はだめですね。

'実作業はここからです

    Range("G2").Formula = "=OR(A2=2,A1=2)"  '数式はさらに苦手で１行にできなかったので
    Range("G3").Formula = "=A2=2"           '追加　　　　　↓変更
    Range("A1:D12").AdvancedFilter xlFilterCopy, Range("G1:G3"), Range("I1"), False

としてください。
（kazuo） 2018/03/16(金) 22:00

なるほどです。
だとすると、↓これでも同じでしょうか。

Range("G2").Formula = "=A1=2"
Range("G3").Formula = "=A2=2"

さらに、こうするとオートフィルタが不要かも。
xlFilterInPlaceにもできますね。

Range("G2").Formula = "=AND(A2="""",A1=2)"
Range("G3").Formula = "=A2=2"

ただ結合セル以外で、空白はない前提ですが。

（マナ） 2018/03/16(金) 22:54

βさんのマクロが、何をしているか、
手作業だと、↓こういうことです。

[[20150403174626]]　『結合セルのオートフィルタ』（GW）

（マナ） 2018/03/16(金) 23:14

 皆様色々とありがとうございます。
 フィルターをかけて済んだ後には元に戻します。
 フィルターを抽出したあとに別シートに貼り付けて消すことも可能ということでしょうか？
（まゆ） 2018/03/16(金) 23:27

 ＞フィルターをかけて済んだ後には元に戻します。

 フィルターって、オートフィルタ－の事ですね。

 それは、一つの項目を抽出したら、それで終わりになる作業ですか？
 それとも、幾つかの項目を何回か抽出して、結果をそれぞれ確認してから終了するんですか？

 念の為の確認ですが、結合とはデータエリアが結合されているんですね？
 つまり、ここの「地域」見たいな状況ということですね？
 　　　　　↓
 【結合セルをオートフィルタで絞り込む】
http://officetanaka.net/excel/function/tips/tips64.htm

（半平太） 2018/03/16(金) 23:47

 半平太さまありがとうございます。
 貼って頂いたサイトのことをやりたいと考えておりました。
 説明不足で申し訳ございませんでした。
（まゆ） 2018/03/17(土) 07:29

 ＞ それは、一つの項目を抽出したら、それで終わりになる作業ですか？
 ＞ それとも、幾つかの項目を何回か抽出して、結果をそれぞれ確認してから終了するんですか？
 　↑
 これにご回答ください。
 1回こっきりの抽出作業なら、オートフィルターにこだわる事もないので。

 別シート方式案は、元に戻すのが「簡単または不要」だからです。

 同じシートで抽出できるようにすると、また元の状態に戻す工程を入れなきゃなりません。
 なんたって、元の状態なんですから、その状態に「加工して」戻すのは無駄感が強いです。

（半平太） 2018/03/17(土) 08:08

 半平太さまありがとうございます。
 ご回答になります。
 幾つかの項目を何回か抽出して、結果をそれぞれ確認してから終了します。
 別シートに抽出したほうが問題が少ないんですね。
（まゆ） 2018/03/18(日) 01:50

 ＞別シートに抽出したほうが問題が少ないんですね。

 なんたって、オリジナル(Sheet1)は、無傷ですからねぇ・・安心です。

 取りあえず・・
 そちらの手操作で「抽出用」シートを追加して貰って、
 マクロでそのシートにSheet1のデータをコピーして抽出作業が出来る状態にする案

 ※何か不具合があったら、追加で対応します。
 　例：「抽出用」シートを自動で追加したい
 　　　マクロが遅すぎるので高速化したい

 ’マクロ (標準モジュールに貼り付けて、setReady4AuFilrを実行する）
 　　↓
 Sub setReady4AuFltr()
     Dim BaseCell As Range

     Application.ScreenUpdating = False

     With Sheets("抽出用")
         Sheets("Sheet1").Cells.Copy .Cells

         Set BaseCell = .Range("A2")

         Do Until BaseCell.Value = ""
             If BaseCell.MergeCells Then
                 Sheets("Sheet1").Range(BaseCell.Address).Copy
                 BaseCell.MergeArea.PasteSpecial xlPasteFormulas
             End If

             Set BaseCell = BaseCell.Offset(1)
         Loop

         Application.Goto .Range("A1"), True
     End With

     Application.ScreenUpdating = True
 End Sub

（半平太） 2018/03/18(日) 12:01

 半平太さまありがとうございます。
 実行させて頂いたところ、リソース不足になりました。
 動作が重いのでしょうか？
（まゆ） 2018/03/19(月) 00:26

 リソース不足ですか？

 リソースなんて大して使ってないと思っているんですが、
 イレギュラーな処理のセイで、メモリーリークでも起こすんですかねぇ・・・

 参考までに以下教えて下さい。
 　現実のデータは 何行 x 何列 の表なのですか？

（半平太） 2018/03/19(月) 07:25

横から口出しですが、
Sheets("Sheet1").Cells.Copy .Cells
ここが、リソース不足の原因とか無いでしょうか？

別の質問者さんのときに、.Cellsで、全セル参照をアドバイスしたら、メモリ不足になってしまい、UsedRangeを追加して回答したことがあります。
（もこな２） 2018/03/19(月) 08:57

 もこな２さん

 アドバイス、有難うございます。

 まゆさん　へ
 　処理スピードには懸念を持っていたので、以下に作り変えました。

 　これでやってみて下さい。
 　　↓
 Sub setReady4AuFltr()
     Application.ScreenUpdating = False

     With Sheets("抽出用")
         .AutoFilterMode = False
         .UsedRange.Clear

         With Sheets("Sheet1").UsedRange
             .Copy Sheets("抽出用").Range(.Address)
         End With

         With Intersect(.UsedRange, .Columns("A"))
             .ClearFormats

             .SpecialCells(xlCellTypeBlanks).FormulaLocal = "=R[-1]C"
             .Value = .Value

             Sheets("Sheet1").Range(.Address).Copy
             .PasteSpecial Paste:=xlPasteFormats
         End With

         Application.Goto .Range("A1"), True
     End With

     Application.ScreenUpdating = True
 End Sub

（半平太） 2018/03/19(月) 09:35

 半平太さまありがとうございます。
 すごく感動です。想像以上で感謝しております。
 色々と情報を頂いた方にも感謝いたします。
 皆様本当にありがとうございます。
（まゆ） 2018/03/20(火) 00:17

コメント返信：

[ 一覧(最新更新順) ]

[[20180315234918]] 『結合部分をフィルター』（まゆ） ページの最後に飛ぶ

[[20180315234918]]　『結合部分をフィルター』（まゆ）　ページの最後に飛ぶ