[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『特定セルの抽出方法』(清水)
ご教授願います。
Aセルのみ重複している数値だけ抽出し、
尚且つ、その中のCセルで重複している数値は除き(非表示)、
Cセル内の中から異なる表記があるグループのみ抽出する事は可能でしょうか?
分かりにくい質問でスミマセン。
画像で参考資料を作成致しました。
よろしければ確認お願い致します。
http://www.fastpic.jp/images.php?file=9662395559.jpg
< 使用 Excel:Excel2013、使用 OS:Windows7 >
- - - - 画像が恐ろしくでかく表示されてしまうので少し編集しました。 あと画像イメージは以下の様な感じで表現しました 例 |[A] |[B] |[C]| |[A] |[B] |[C] |1111|ああああ |○ | |3333|ええええ |× |1111|いいいい |○ | |3333|おおおお |○ |2222|ううううう|○ | → |3333|ああああ |○ |3333|ええええ |× | |6666|いいいい |× |3333|おおおお |○ | |6666|ううううう|○ |3333|ああああ |○ | | | | |4444|いいいい |○ | | | | |5555|ううううう|○ | | | | |5555|ええええ |○ | | | | |5555|おおおお |○ | | | | |5555|ああああ |○ | | | | |6666|いいいい |× | | | | |6666|ううううう|○ | | | | ちなみに↓コレを利用させてもらいました [[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか?』(momo)
(ご近所PG) 2015/07/06(月) 17:13
今私もmomoさんのツールで補正しようかなと思ってたところです。 すざましかったですね。表示を35%ぐらいにしても、スクローロールが必要でした。
それはさておき、
A列が同じ値のグループで、C列がグループごとに同じ値であれば非表示(削除じゃなく非表示ですね) A列のグループ単位でC列に複数の値があれば残すということですね。 で、1行しかないグループは、当然、C列に複数の値がないので残る。
こういうことですね。
(β) 2015/07/06(月) 17:21
凄まじいスケールの画像を張り付けてしまい
申し訳ございません…
返答内容は仰る通りでございます。
この内容でご理解いただけて感謝です。
ただ、3行目
【1行しかないグループは、当然、C列に複数の値がないので残る。】
に関しまして、残したいのはC列に複数の値があるものだけなので、
1行しかないものは、それも一つのまとまったグループと同じに考え、非表示としたいです。
【2222】【4444】といった一行ものは、非表示としたいという事です。
(清水) 2015/07/06(月) 17:31
>>残る は、βの記述ミスでした。これは残らないと理解しています。
処理効率は悪いのですが、手っ取り早く1行ずつ処理している例です。 もう少しスマートなものを書いてみようとは思いますが。
Sub Test1() Dim c As Range Dim r As Range Set r = Range("A1").CurrentRegion For Each c In r.Columns(1).Cells If WorksheetFunction.CountIf(r.Columns(1), c.Value) = WorksheetFunction.CountIfs(r.Columns(1), c.Value, r.Columns(3), c.Offset(, 2).Value) Then c.EntireRow.Hidden = True Next End Sub
(β) 2015/07/06(月) 17:54
「ダササ」は↑のまんまですが、非表示を一括にしただけのコードです。(非表示行数が多ければ少しは早くなります)
Sub Test2() Dim c As Range Dim r As Range Dim a As Range
Set r = Range("A1").CurrentRegion
For Each c In r.Columns(1).Cells If WorksheetFunction.CountIf(r.Columns(1), c.Value) = WorksheetFunction.CountIfs(r.Columns(1), c.Value, r.Columns(3), c.Offset(, 2).Value) Then If a Is Nothing Then Set a = c Else Set a = Union(a, c) End If End If Next
If Not a Is Nothing Then a.EntireRow.Hidden = True
End Sub
(β) 2015/07/06(月) 17:59
このへんで打ち止めにしますが、データ量が膨大なら以下がいいかも。
Sub test3() Dim c As Range Dim r As Range Dim f As Range Dim t As Range Dim a As Range Dim ovalue As String Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary") Set r = Range("A1").CurrentRegion
Set f = r.Columns(1).Cells(1) ovalue = f.Value
For Each c In r.Columns(1).Resize(r.Rows.Count + 1).Cells
If c.Value <> ovalue Then If dic.Count = 1 Then If a Is Nothing Then Set a = Range(f, t) Else Set a = Union(a, Range(f, t)) End If End If
dic.RemoveAll Set f = c End If Set t = c dic(c.Offset(, 2).Value) = True ovalue = c.Value Next
If Not a Is Nothing Then a.EntireRow.Hidden = True
End Sub
(β) 2015/07/06(月) 18:16
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.