excelのデータで色つき行の抽出方について教えてください

excelでシート一つでデータを入れてるのですが列の一部分行の数箇所に黄色で色をつけてるのですがその色つきの行だけを抽出したいのですが色での抽出ってできますか？教えてください　急いでいます

No.8 ベストアンサー 回答者： shishishishi 回答日時： 2004/04/21 13:31

やはりフォントではなくセルの色だったんですね。

とんだ回り道をしてしまいました。
で、こんどは新条件登場ですか。

確認です。
データはZ列以降には入っていませんね？
データは4001行以降には入っていませんね？
A～D列のどれか一つでもセルに色がある行は抽出するのですね？

そうであれば以下で試してください。
今度は、上記の条件に合致するものを並べ替えで上にもってくるやり方です。

Sub IROTEST3()
For i = 1 To 4000
For x = 1 To 4
If Cells(i, x).Interior.ColorIndex <> xlNone Then Cells(i, 27).Value = 1
Next x
Next i
Range("A1:AA4000").Select
Selection.Sort Key1:=Range("AA1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
Range("AA:AA").ClearContents
End Sub

この回答への補足

ヤッター！大成功です。ほんとに遠回りさせてしまいました。説明不足ですみませんでした。さあ仕事頑張るぞー！これを機に未知のVBA？マクロ？を少し勉強してみようかなあと・・・でもさっぱり？？？です。皆さんはどのようにして覚えていかれたのでしょう？ほんとにありがとうございました。

補足日時：2004/04/21 14:18

No.7 回答者： shishishishi 回答日時： 2004/04/20 10:16

No2~5です。

行の色って、ひょっとしてフォントではなくセルの色のことですか？！
それだったらとんだ勘違いをしていました。
以下は、セルに色をつけてあるものだけをB列に転記するVBAです。

Sub IROTEST2()
n = 1
For Each c In Range("A1:A4000")
If c.Interior.ColorIndex <> xlNone Then
Cells(n, 2).Value = c.Value
n = n + 1
End If
Next
End Sub

この回答への補足

ごめんなさい返信がおそくなりました。あの～NO7で成功はしましたが・・・私の説明が少なかったですのでもう一度お願いいたします。一行にはデータがY列まで入ってます。Y列までの内、色はABCD列につけてます。この結果ではB列にＡ列の色つきのデータのみが順次表示されＢ列からは結果以前のデータで結果的にはデータが狂ってしまいます最初の質問的には成功だと思いますがA列からY列まですべてが順次移動できるようにはできないでしょうか？よろしくお願いいたします。ペコリ

補足日時：2004/04/21 11:47

No.6 回答者： imogasi 回答日時： 2004/04/19 22:29

同じくＶＢＡですが、色を付けていない行を削除する方法でどうでしょう。

色は、文字色ではなく、パターン（セルの色付き）の方で考えています。
（１）シートのコピーをする。
（２）下記を実行する。
Sub test03()
cl = "n"
For i = 20 To 1 Step -1
For j = 1 To 10
If Cells(i, j).Interior.ColorIndex = 6 Then
cl = "y"
Else
End If
Next j
If cl = "n" Then
Rows(i).EntireRow.Delete
End If
cl = "n"
Next i
End Sub
色付きのセルの行のみ残ります。
（注意）For i = 20 To 1 Step -1の２０は最下行の行数
で置き変える。また
For j = 1 To 10の１０は列番号の左（Ａ列）より何番目までデータがあるかで変える。Ｊ列までなら１０、Ｏ列までなら１５に変える。
色付きであるなら、
If Cells(i, j).Interior.ColorIndex = 6 Thenは
If Cells(i, j).Interior.ColorIndex <> xlAutomatic
Thenにする。

この回答への補足

回答ありがとうございます。知識がなにもなくて説明のとおり20を4000（行）に10を25（Y列）にその下の行は最後の説明をコピペしてマクロの実行をしましたが何も変わらなかったです。再度教えてください。お願いいたします

補足日時：2004/04/21 13:46

この回答へのお礼

先ほど新たにお願いをいたしましたがshiShishishiさんの回答で解決いたしましたので締め切りたいと思います。ありがとうございました。また教えてください。

お礼日時：2004/04/21 16:11

No.5 回答者： shishishishi 回答日時： 2004/04/19 16:37

了解です。

黄色以外の「色なし」とは「自動」ということですね？
それならこれでどうだあ～っ。

もちろんNo5のみのコピペでいいですよ。
前にコピペしたのは消してくださいね。

だんだん自信がなくなってきました。（笑）

Sub IROTEST()
n = 1
For Each c In Range("A1:A4000")
If c.Font.ColorIndex <> xlAutomatic Then
Cells(n, 2).Value = c.Value
n = n + 1
End If
Next
End Sub

No.4 回答者： shishishishi 回答日時： 2004/04/19 15:16

追伸です。

もしNo3のでも駄目だった場合、黄色い外のセルは何色に指定してあるのか、あるいは指定が無いのか、お知らせください。

No.3 回答者： shishishishi 回答日時： 2004/04/19 15:08

>A列がそっくりＢ列にコピーされただけ

おや、それはこまりましたね。
でもVBAが動いたことだけは確認できました。（笑）

それではこれで試してください。フォントはただの黄色なんですね？
それからさっきのではA列を上から下まで見るので時間がかかりすぎますね。とりあえず500行めまでにしてみましたが、もっとデータがあるのであればA500を変えてください。

Sub irotest()
n = 1
For Each c In Range("A1:A500")
If c.Font.ColorIndex = 6 Then
Cells(n, 2).Value = c.Value
n = n + 1
End If
Next
End Sub

この回答への補足

行は4000あるので500を4000に変えて実行しましたが今回は変化なしでした。no3のみのコピペでよかったのですよね。色は他につけてたところは色ナシにして黄色のみにしたのですが・・・すみませんまたよろしくお願いいたします。

補足日時：2004/04/19 16:19

No.2 回答者： shishishishi 回答日時： 2004/04/19 11:04

お急ぎということなので、VBAでの一発回答を。

A列にデータが入っていて、その中の色つきのセルのデータのみB列の上から順番に表示させる方法です。
失敗するとまずいのでまずはバックアップをとってからテストしてみてください。

１．Alt + F11
または、[ツール] メニューの [マクロ] をポイントし、　 Visual Basic Editorをクリックします。

２．Visual Basic Editor ウィンドウのメニューから、
　[挿入]→[標準モジュール] をクリックします。

３．表示されたコードウィンドウに以下のマクロコード（SubからEnd Subまで）をコピペします。

４．ワークシートに戻り、[ツール] メニューの [マクロ] →「マクロ」で今貼り付けたマクロ名（irotest）を選択して、実行。


Sub irotest()
n = 1
For Each c In Range("A:A")
If c.Font.ColorIndex <> 0 Then
Cells(n, 2).Value = c.Value
n = n + 1
End If
Next
End Sub

この回答への補足

実はマクロもVBAも全く知識なく一応コピペでA列に色つきを移動させて実行してみましたがA列がそっくりＢ列にコピーされただけで上から順番にも表示されませんでした。どこが悪かったのでしょうかよろしければ再度お願いいたします

補足日時：2004/04/19 14:11

No.1 回答者： mshr1962 回答日時： 2004/04/19 10:52

【エクセル技道場】

http://www2.odn.ne.jp/excel/
上記から名前定義の23名前定義で4.0マクロ関数を使う
を参照してください

これでなければVBAになると思います。

参考URL：http://www2.odn.ne.jp/excel/

この回答へのお礼

回答ありがとうございました。開いては見たのですが私には難しすぎました。勉強したいと思います。

お礼日時：2004/04/21 16:16