エクセル ピボットテーブルで同一列内の同じ文字を抽出

質問

マクロを使い、ピボットテーブル上でＡ列の任意の文字をクリックすると、
Ａ列を検索して同じ文字があれば抽出した行を反転？(青くなる奴です)したいです。

　　Ａ　　　　Ｂ　　　　Ｃ　　・・・
１　大阪　　５０
２　静岡　　１５
３　東京　　３３
４　大阪　　１４
５　大阪　　０５
６　東京　　８８

この場合、セルＡ５の"大阪"をクリックするとＡ列の１行目と４,５行目の"大阪"の文字をキーワードに、１・４・５行を反転させたいのですが可能でしょうか？
当方エクセル、ＶＢＡともに初心者です。よろしくお願いします。
補足　Ａ６セルをクリック(Ａ６セルの上にカーソルがある状態)すれば３・６行を反転という事です。

回答No.5

OtenkiAme · ベストアンサー

こんにちは。

検索と置換を使ったサンプルを提示しますね。
検索を使った処理は、ヘルプファイルのサンプルマクロをアレンジしたものです。
置換を使った処理は、マクロの記録で記録した処理をアレンジした処理です。

「任意のセルを選択(クリック)した都度」なら
Private Sub Worksheet_SelectionChange(ByVal Target As Range)内に中のコードだけコピペしたらできないですかね。

Sub XL2000以降なら検索で()

　　Dim c As Range
　　Dim FirstAddr As String

　　'アクティブセルが空白なら処理しない
　　If ActiveCell.Value = "" Then Exit Sub

　　'ピボットテーブルで
　　With ActiveSheet.PivotTables(1)

　　　　'クラシック形式に（書式をリセット）
　　　　.Format xlPTClassic

　　　　'ページエリアを除くピボットテーブルエリアで
　　　　With .TableRange1

　　　　　　'アクティブセルの値を検索
　　　　　　Set c = .Find(ActiveCell.Value, LookIn:=xlValues)
　　　　　　'アドレスを記憶
　　　　　　FirstAddr = c.Address

　　　　　　'以下繰り返し
　　　　　　Do

　　　　　　　　'フォントを青で太字に
　　　　　　　　With c.Font
　　　　　　　　　　.ColorIndex = 5
　　　　　　　　　　.Bold = True
　　　　　　　　End With

　　　　　　　　'次を検索する
　　　　　　　　Set c = .FindNext(c)

　　　　　　'記憶したアドレスでない間は繰り返す
　　　　　　Loop While c.Address <> FirstAddr

　　　　End With

　　End With

End Sub

Sub XL2002以降なら置換でも()

　　'アクティブセルが空白なら処理しない
　　If ActiveCell.Value = "" Then Exit Sub

　　'置換後に設定する書式を設定する
　　With Application.ReplaceFormat.Font
　　　　.FontStyle = "太字"
　　　　.ColorIndex = 5
　　End With

　　'ピボットテーブルで
　　With ActiveSheet.PivotTables(1)

　　　　'クラシック形式に（書式をリセット）
　　　　.Format xlPTClassic

　　　　'ページエリアを除くピボットテーブルエリアで
　　　　With .TableRange1

　　　　　　'アクティブセルを置換（置換後もアクティブセルと同じにして書式を変更）
　　　　　　.Replace What:=ActiveCell.Value, _
　　　　　　　　Replacement:=ActiveCell.Value, ReplaceFormat:=True

　　　　End With

　　End With

End Sub

お礼

度々のご回答の上、サンプルマクロまで頂き本当に頭が下がる思いです。

>XL2002以降なら置換でも
の方を使かわせて頂きました。おかげさまで２ヶ月の間悩み続けた
「アクティブセルと同じ文字を選択範囲から色変更等で見付だす事」が出来ました。
感謝の気持ちでいっぱいです。
本当に有り難う御座いました。

>XL2000以降なら検索で
の方も何かに応用出来ないかと考えた末、同じ文字を見つけた個数の取り出しに使えそうだと気づき
フォントと色を変える代わりに個数をカウントして見たのですが、やはりうまくいきません。

もし、お暇があれぱで結構ですので頂いたサンプルマクロの解らない所をご教授願えませんでしょうか。

５行目と６行目が
　　　　.Format xlPTClassic　←Ｇ列の書式のリセット
　　　　 With .TableRange1　 ←Ｇ列のエリアを
と指定の列だけを検索するような動きに成りませんでしょうか？
解らないながら「TableRange2」や「columnrange」や「databodyrange」等を当てはめて見ましたが
エラーばかりで全く動く気配すらありませんでした。

※以下は頂いたコードを元に「同じ文字を見つけた個数をカウント」に変えてみたのですが
Ｇ列以外も検索対称にしている為、他の列の同じ文字の個数までカウントしてしまう状態なのです。

Sub XL2000以降なら検索で()
　　Dim c As Range
　　Dim FirstAddr As String
　　If ActiveCell.Value = "" Then Exit Sub
　　With ActiveSheet.PivotTables(1)
　　　　.Format xlPTClassic　　　　'←Ｇ列の書式のリセットが解りましたら是非とも・・
　　　　With .TableRange1 '←どうやっても列の指定にならない部分です
　　　　Set c = .Find(ActiveCell.Value, LookIn:=xlValues)
　　　　FirstAddr = c.Address
　　　　Do
　　　　aa=aa+1　　　　　　　　　　'←フォント変更の代わりに個数をカウントしています
　　　　Set c = .FindNext(c)
　　　　Loop While c.Address <> FirstAddr
　　　　End With
　　End With
　　　　aa=aa/2 '←よく解りませんがカウントが２倍になるので・・・
　　　　If aa >= 2 Then MsgBox aa　'←件数が２件以上ならメッセージ
End Sub

補足

ご教授お願いしますの件、自己解決しました。

今まで助言やアドバイス、サンプルマクロまで頂き本当に有り難う御座いました。
心より感謝しております。

※　７行目の最後に「LookAt:=xlWhole」を付けると列だけを検索する動きに成りました。
(正直意味は解りませんが動くので良しとしています。)

回答No.4

OtenkiAme

こんにちは。

> VBAを使えばアクティブセルと同じ文字を選択範囲から反転(又は色変更)等で見付だす事が出来そうかと思っていたのですが想像以上に難しい事が分かって来た次第です。
出来ますよ。アクティブセルを対象に「検索」を使えばいいと思います。
マクロの自動記録をとりながら、適当な文字を検索する処理をしてコードを入手します。記録されたコードの Find にカーソルを当てて、F1キーを押し、ヘルプファイルを表示させます。そこにそのものずばりの同じ文字を繰り返して探すサンプルコードが載っているので、それを参考に組むといいと思います。

ご質問の内容を改めて読んでみました。方法はいろいろ考えられると思うのですが、どのタイミングで色を付けるのかが分らないです。
目的のセルを選択してからマクロを実行させるのか、また、「セルを選択した都度」、「更新した都度」というタイミングなのか、処理する方法も含めてその辺りはよく考えて組まれた方がいいと思います。

今は、条件付書式を試されているようですが、XL2003まではレイアウトを変えたりすると対応できない部分ができるのであまりお勧めしません。

それで、「セルを選択した都度」、「更新した都度」というのは、エクセルに用意されたイベントプロシージャを利用して処理することができます。
条件付書式を使うのであれば、「更新した都度」その条件付書式の設定をしてあげればいいと思います。
「セルを選択した都度」ですが、昔作ったサンプルマクロを提示しますので適当なピボットテーブルを作って試してみてください。コメントを追加しましたので読んでいただければ難しいことをしていないのが分ると思います。
PivotSelect…って言ったんですが、改めて同じような処理を作ってみると面倒くさかったので止めました。(笑)

１．適当なピボットテーブルを作成する。
２．以下に示したマクロコードをコピーする。
３．ピボットテーブルのあるシート見出しを右クリックして「コードの表示」を選択する。
４．表示されたコードウィンドウにコピーしたマクロコードを貼り付ける。
５．ピボットテーブルのシートに戻って選択処理を行なう。
（複数のセル範囲が選択されると選択した範囲の文字が青の太字になる。）
（更新をかけても設定した書式はなくなりません。）

【ちょっと解説】
Worksheet_SelectionChangeプロシージャは、セルが選択された時に実行されるプロシージャで、選択されたセルの情報は、プロシージャの引数（Target）に引き継がれています。そのTargetを元に処理してあげるといいです。注意点は、処理の中で「選択する」処理を使う場合は、イベント機能を無効にする Application.EnableEvents = False を最初に入れて、最後に Application.EnableEvents = True を入れてイベント機能を有効にしておきます。

また、ピボットテーブルが更新された時にマクロを実行させるなら、XL2000以降であれば、Worksheet_Calculateプロシージャ、XL2002以降であれば、Worksheet_PivotTableUpdateプロシージャを使うことができます。（コードウィンドウの右上のプロシージャリストボックスから選択できます。）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

　　Dim PvtTbl As PivotTable 'ピボットテーブルとして変数を宣言

　　'ピボットテーブルがなかったら終了
　　On Error Resume Next
　　Set PvtTbl = Me.PivotTables(1)
　　On Error GoTo 0
　　If PvtTbl Is Nothing Then Exit Sub

　　'ピボットテーブルをクラシック形式にする（書式をリセット）
　　PvtTbl.Format xlPTClassic

　　'選択した範囲がピボットテーブルの範囲に含まれていて
　　If Not Application.Intersect(Target, PvtTbl.TableRange2) Is Nothing Then

　　　　'選択したセルの数が2個以上だったら
　　　　If Target.Cells.Count > 1 Then

　　　　　　'選択した範囲の文字を青の太字にする
　　　　　　With Target.Font
　　　　　　　　.ColorIndex = 5
　　　　　　　　.Bold = True
　　　　　　End With

　　　　End If
　　End If

　　'使用した変数を開放する
　　Set PvtTbl = Nothing

End Sub

お礼

ご指南ご指摘、本当に有り難う御座います。
マクロの自動記録からコードを入手しましてFindのヘルプにあるそれらしいコードを試しました。
選択範囲から同じ数字を検索して違う数字に置き換えると言うもので、いろいろ試しましたがどうしても「アクティブセルを検索して」と言う動きにならず挫折寸前です。
>それを参考に組むといいと思います。
せっかくのご指南、まだまだそのレベルに無く本当に申し訳ない限りです。
因みにＯＳはＸＰ ｐｒｏ、 ＸＬ２００３を使用しております。
タイミングの話ですが、「任意のセルを選択(クリック)した都度」Ａ列の中から同じ文字を検索して
合致した全てのセルの色を変える(又は行の反転)のが望ましいのですがうまくいきません。
サンプルマクロ、本当に有り難う御座います。
素人の私にも何をしているか解り易い注釈のおかげで、すごく勉強になりました。
「複数のセル範囲が選択されると動く」マクロが何かに流用出来ないか思案中です。
>【ちょっと解説】
の話でイベント機能の有効、無効の件、非常に助かりました。
エラーの出る前後にこの命令を挟むとエラーが無くなりました。

回答No.3

OtenkiAme

こんにちは。

ピボットテーブルの機能だけですが……

選択したいアイテムのセルの左端にマウスポインタを置くと、
ポインタの形状が　右方向の太い矢印（→）になると思います。

その状態でマウスをクリックすれば、そのフィールドの選択した
アイテムの全てが選択された状態になります。
必要なら、セルに色をつければいいのではないでしょうか？

なお、その状態でピボットテーブルツールバーのピボットテーブル－選択
を利用すれば、ラベルだけ、データだけの選択も可能ですので試して
みたら如何でしょうか。

マクロで…とお考えのようですが、マクロの自動記録を行ないながら
上記操作を行なえば、操作に必要なコードは入手できます。

～.PivotSelect "hogehoge" , xlDataAndLabel, True
のように記録されるはずですから、"hogehoge" を ActiveCell.Text
に修正すればいいと思います。（エラー処理はないですが…）

ただ、手作業（選択する－色を付ける）をマクロ（選択する－色を
付けるマクロを実行する）で行なうメリットがあるとは思いません。

補足

ご返答誠に有難う御座います。
ご指摘を受けました、ピボットテーブルで使う矢印(↓)で範囲選択後の条件付書式は一部使わせて貰っております。
ピボットテーブルの書式で「更新すると設定が"消える所も"ある」と書かせて貰った点ですが、
Ａ列以外を非表示にしている状態でＢ、Ｃ列の空白の部分にＡ１と同じ色を付けても詳細のデータ表示から非表示にしたり、更新すると空白に戻るという点です。
>ActiveCell.Text　試させて頂きました。
何かに使えそうですが、スキルが足らず申し訳ないです。

VBAを使えばアクティブセルと同じ文字を選択範囲から反転(又は色変更)等で見付だす事が出来そうかと思っていたのですが想像以上に難しい事が分かって来た次第です。

当方それほど急いでいるわけでは無いので、１年計画で少しずつ前進する所存です。
何か良い知恵が御座いましたらお助け願いますでしょうか。

回答No.2

ultraz

お役にたてるか分かりませんが、参考ＵＲＬ内の
解答の中で、セルをクリックするとそのセルの値
と同じものを探しセルに色をつけるマクロがあり
ました。
応用すれば、セルだけではなく、行に色をつけ
ることも出来るはずです。
今更ですが、なぜ、ピボットテーブルを使わなけ
ればならなくなったのでしょうか？

参考URL：

http://questionbox.jp.msn.com/qa182536.html

お礼

度重なる御指導誠にありがとうございます。
ご指摘のピボットテーブルを使う理由ですがエクスプローラ的(階層的な意味)な使い方が出来る点でしょうか。
顧客管理として使っておりまして、恥ずかしながら使っているフィールドは行フィールドだけしか使っていないようなものです。なので集計や合計等の計算も必要ありません。
その行フィールドはＡ～Ｐ列まであり、普段は目次としてＡ列だけ見えてる状態です。
Ａ列の任意のセルをＷクリックするとピボットテーブルの機能である詳細のデータ表示で行数が１～１００行ほどのデータが階層的に展開します。
実際にはＧ列に今回のマクロを使いたいのですが質問では分かり易くＡ列とさせて頂きました。

参考ＵＲＬありがとうございます。
分からないながらコードをコピペしていろいろやってみましたがどうも二つとも違うようでした。
一つは指定したエリアの同一文字の色を変えるものでどうにか流用できないかとがんばりましたが自分のスキルでは無理でした。(任意のセルとは関係なく同じ文字だけに色がつくマクロでした)
もう一つは任意のセルに入力後(もしくはＷクリック後)、色が変わるような挙動でしたがよく分かりませんでした。

二つとも共通した点として"任意のセルをクリック後"そのセルと同じ文字を探していない点でした。

以上の点をふまえ考えたのですが
　IF　アクティブセルの値が指定エリアのセルの値と同じ　Then
とはVBAでどのように書けばよいのでしょうか?

>応用すれば、セルだけではなく、行に色をつけることも出来るはずです
手がかりすらない状況ですが
少しずつでも前進出来ればと考える次第です。

回答No.1

ultraz

選択されたセルを反転させたい理由がはっきりしません
が、抽出すれば良いのであれば、参考ＵＲＬをご覧にな
ればピボットテーブルでデータを抽出する方法などがあ
ります。
それから、ピボットテーブルで集計したデータを加工する
には、一度ピボットテーブル全体をコピーして値のみを別
の場所に貼り付ける。それから、やりたい作業をするよう
なマクロを作成するほうが簡単だと思います。

参考URL：

http://www.officepro.jp/exceltips/pivot/index.html

補足

ご指導誠にありがとうございます。
反転の理由として、オペレーター側が"大阪"というキーワードから続くデーターを
画面の中から探しやすい事がその理由になります。
なので条件付書式などでセルの色をグレーにする事も考えましたが
ピボットテーブルとの相性が悪いのか、
設定しても更新すると消える所もあり見送りました。
オートフィルターなどの抜き出しで１・４・５列だけの表示では
その周りのデータとの近似値をオペレーター側が判断出来ないという理由があり見送りました。
参考ＵＲＬ読ませて貰いました。ピボットテーブルがあまり理解できてないので助かります。
しかし元来バカなので抽出方法が解らず困り果てました。
抽出の処理でvlookup関数などもググりましたがマクロとの相性が悪いのか
エラー処理やたくさん発見した時の処理があるらしくよく解りませんでした。
後、セルＡ５の"大阪"をクリックするとマクロでピボットテーブルのデータをコピーして
別シート等で値のみの貼り付け後１・４・５列を見つけて反転させるのも、
結局ココ(キーワード抽出後反転)が解りませんでした。
以下は見よう見真似の現在のマクロで、任意のセルをクリック後その行を反転というところまでなのです。
何かよい知恵は有りませんでしょうか？

シートのコード
Private Sub worksheet_selectionchange(ByVal Target As Range)
If ActiveCell = "" Then Exit Sub　 '空白セルなら何もしない
If Target.Column = 1 Then マクロ1　'Ａ列をクリックしたら"マクロ1"へ
End Sub

Sub マクロ1()
' 任意のセルから行の取得
Dim i As Long
With ActiveCell
i = .Row
Rows(i).Select　'行の反転
End With
End Sub