[[20140820110831]]　『特定の文字があったら残したい。』（餃子大好きっ娘）　ページの最後に飛ぶ

『特定の文字があったら残したい。』（餃子大好きっ娘）

 初めまして。
 検索したんですけど思い描いていたVBAが見つからなかったので
 質問します。よろしくお願いします。

 	A	B	C
1	ZZZ	00	X
2	ZZZ	00	X
3	ZZZ	01	P
4	ZZQ	00	X
5	ZZQ	03	P
6	Z11	00	X
7	ZRT	00	X
8	ZRT	00	X
9	ZMM	05	P

 上記の内容なのですが
 １　A1セルに入っている「ZZZ」において
 　C列に「P」がある場合、削除しない。

 ２　A7セルにある「ZRT」では
 　C7セルからC8セルにおいて「P」がないから削除する。

 こんな感じでA列に入っている同じ文字の範囲でC列に「P」が
 ある行は削除せず、「X」だけの時のみ削除したいです＞＜

 最終的に上記の表から
 下記の表になりたいんです＞＜

 	A	B	C
1	ZZZ	00	X
2	ZZZ	00	X
3	ZZZ	01	P
4	ZZQ	00	X
5	ZZQ	03	P
9	ZMM	05	P

 なお、A列は並び替え済みで、A列を基準にB列も並び替え済みです。
 ちなみにB列は「00」以外すべてC列に「P」が付きます。

 どうかよろしくお願いします＞＜

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

 Evaluateの練習用に作ったものです。
 考え方が間違ってたらごめんなさい。
    Sub 天さんごめんね()
        Dim FindP As String
        Dim FindA
        Dim Z列 As String
        Dim P列 As String
        Z列 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Address(0, 0)
        P列 = Range("C1", Range("C" & Rows.Count).End(xlUp)).Address(0, 0)
        FindP = Join(Filter(Application.Transpose(Evaluate("IF(" & P列 & "=""P""," & Z列 & ",""-"")")), "-", False), ";")
        FindA = Join(Filter(Application.Transpose(Evaluate("IF(ISERROR(FIND(" & Z列 & ",""" & FindP & """)),ROW(" & Z列 & ")&"":""&ROW(" & Z列 & "),""-"")")), "-", False), ",")
        'Range(FindA).Delete '★消す場合
        Range(FindA).Interior.Color = vbYellow 'テスト用に色つけのみ
    End Sub
（稲葉） 2014/08/20(水) 14:52

 はじめまして稲葉さん。
 さっそく素敵なVBAありがとうございます！
 ただ使ってみたんですがセルの行がすべて黄色くなるだけで終わってしまいます＞＜

 たぶん私が手を加えないといけない場所は下記の場所だと思うんですが
         Z列 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Address(0, 0)
         P列 = Range("C1", Range("C" & Rows.Count).End(xlUp)).Address(0, 0)
 手は加えられた(必要なセルを設定とか)できたんですが
 質問に入れた「P」とか「X」を判断する記述はどこをいじればいいでしょうか？(汗
（餃子大好きっ娘） 2014/08/20(水) 15:08

 Sub testEvaluate()
    Dim x
    With Cells(1).CurrentRegion
        x = Filter(Evaluate("transpose(if(" & .Columns(3).Address & "=""P"",row(" & .Address & "),char(2)))"), Chr(2), 0)
        x = Application.Transpose(Application.Index(Application.Transpose(.Value), Evaluate("row(1:" & .Columns.Count & ")"), x))
        .Offset(1).ClearContents
        .Offset(1).Resize(UBound(x)).Value = x
    End With
End Sub

 Sub testAutofilter()
    With Cells(1).CurrentRegion
        .AutoFilter 3, "X"
        .Offset(1).SpecialCells(12).EntireRow.Delete
        .AutoFilter
    End With
End Sub
（　seiya） 2014/08/20(水) 15:10

 =COUNTIFS(A:A,A1,C:C,"P")
 こんな式が「0」の行が削除対象行ですね？
 　
（HANA） 2014/08/20(水) 15:11

 すみません＞＜　seiyaさんとHANAさん初めまして。
 書いてある内容がよくわかりませんでした＞＜
 １、　seiyaさん方は、
         x = Filter(Evaluate("transpose(if(" & .Columns(3).Address & "=""P"",row(" & .Address & "),char(2)))"), Chr(2), 0)
 と書かれている中のPを該当する言葉に変えたんですが型がありませんとVBAから言われ
 VBAが落ちてしまいます＞＜
 ２、HANAさんの方は、すみません；；何を聞いていらっしゃるのかがわかりません；；ごめんなさい。

 やはり例題での質問の仕方では回答者の方に大変迷惑がかかると思うので
 もっと現実に近い形で書きます；；
 すみません＞＜

 	P	S	T
1	P番	日付	判定　←題名が入ってる行がありました
2	ZZZ	00	消
3	ZZZ	01	残す
4	ZZQ	00	消
5	ZZQ	03	残す
6	Z11	00	消
7	ZRT	00	消
8	ZRT	00	消
9	ZMM	05	残す
 ※A列～O列まではありますが省きました。
 ※P列～T列は空白のセルは一つも生まれません。

 処理でやりたいこと
 １．P番のZZZは２行あるが判定で「残す」となるので、触らない。
 ２．ZZQも同上。
 ３．Z11とZRTは判定で「消」しかないので削除します。
 ４．ZMMは１行だけですが、判定が「残す」だけなので触らない。
 ※なお、判定列に「消」とか「残す」という言葉が入っている限り処理をする。

 上記のやりたいことを処理すると・・・

 	P	S	T
1	P番	日付	判定　←題名が入ってる行がありました
2	ZZZ	00	消
3	ZZZ	01	残す
4	ZZQ	00	消
5	ZZQ	03	残す
9	ZMM	05	残す
 こんな感じにしたいです＞＜

 改めてよろしくお願いします＞＜　すみません＞＜
（餃子大好きっ娘） 2014/08/20(水) 15:37

 私の場合Evaluate以前に数式についての知識が無さ過ぎますね・・・
 お二方にはいつも勉強させてもらっています。
 最初のコンセプト通り、HANAさんの式をおかりして・・・

    Sub 天さんごめんね2()
        Dim FindA As String
        Dim Z列 As String
        Dim P列 As String
        Dim 検索文字 As String
        Z列 = Range("A2", Range("A" & Rows.Count).End(xlUp)).Address(0, 0) '列の指定です。Aの部分を実際に合わせてください
        P列 = Range("C2", Range("C" & Rows.Count).End(xlUp)).Address(0, 0) '列の指定です。Cの部分を実際に合わせてください
        検索文字 = "残す" '検索文字の指定です。残すの部分を実際に合わせてください
        FindA = Join(Filter(Application.Transpose(Evaluate("IF(COUNTIFS(" & Z列 & "," & Z列 & "," & P列 & ",""" & 検索文字 & """)=0,ROW(" & Z列 & ")&"":""&ROW(" & Z列 & "),""-"")")), "-", False), ",")
        'Range(FindA).Delete '★消す場合
        Range(FindA).Interior.Color = vbYellow 'テスト用に色つけのみ
    End Sub

（稲葉） 2014/08/20(水) 15:42

 とりあえず、U列を挿入して下さい。
 U2セルに =COUNTIFS(P:P,P2,T:T,"残す")
 の式を入れて、下にフィルドラッグしてみて下さい。

 すると、「0」が表示されている行が消したい行と一致しますよね？
 オートフィルタ等で絞り込んで　0の行を削除するか
 0以外の行をコピーして別の所に貼りつけるかすると
 目的のデータだけの表になると思います。

 実際は、U列ではなく空き列を使う　等してもらったら良いと思いますが。
 　
（HANA） 2014/08/20(水) 15:52

 なんか全然違う質問になっちゃったね...

 Sub testEvaluate()
    Dim x
    With Cells(1).CurrentRegion
        x = Filter(Evaluate("transpose(if(countifs(" & .Columns("p").Address & "," & .Columns("p").Address & _
        "," & .Columns("t").Address & ",""残す""),row(" & .Address & "),char(2)))"), Chr(2), 0)
        x = Application.Transpose(Application.Index(Application.Transpose(.Value), Evaluate("row(1:" & .Columns.Count & ")"), x))
        .Offset(1).ClearContents
        .Offset(1).Resize(UBound(x)).Value = x
    End With
End Sub
（seiya） 2014/08/20(水) 16:10

 稲葉さん、HANAさん、かいとうありがとうございます！
 自分なりに今回いただいた回答を分析し
 「ちゃんと理解したよ！ ここまで理解できたよ！
 　でもここがまだ理解できないのでよかったら教えてください！」
 とお話がしたいので、返答は二晩ほどお待ちください。
 必ず返信しますのでほんと、その時はよろしくお願いします。

 あと、稲葉さんの新たに書かれたVBAは、設定箇所の指示通りに書き換えたら
 動きました！ほんとうにありがとうございます！
 ただまだVBAの内容をきちんと理解していないで私が使っているので
 最初に書いた通り、二晩、お待ちください。
 お礼の意味も込めて、理解した部分を書き込みたいのです。

 それでは今はこの辺で。
 本当にありがとうございました！
 では、金曜の昼間にまた来ます！
（餃子大好きっ娘） 2014/08/20(水) 16:14

 あ！seiyaさんと衝突してしまいました＞＜
 ごめんなさい。
 seiyaさんのVBAも勉強してきますので
 お礼はあらためて明後日の金曜日にします！
 お待たせしてしまってすみません；；

（餃子大好きっ娘） 2014/08/20(水) 16:16

コメント返信：

[ 一覧(最新更新順) ]

[[20140820110831]] 『特定の文字があったら残したい。』（餃子大好きっ娘） ページの最後に飛ぶ

[[20140820110831]]　『特定の文字があったら残したい。』（餃子大好きっ娘）　ページの最後に飛ぶ