Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8 : Excel 2016)
色付きセルのデータを抽出したい
投稿日時: 17/12/26 11:21:37
投稿者: momo0717

マクロの勉強を兼ねて、データ抽出のマクロを考えています。
A〜B列に数値が入っており、C〜D列へ計算結果を入れ、その結果をもとに、セルへ色付けを行うマクロを作りました。
その後、色付きセルをF〜G列へ抽出したいと考えていますが、うまくいきません。
セルに色を付けるまでのマクロは下記になります。
Sub 練習()
    Dim i
    Dim j
     
    For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
         
        For j = 1 To Cells(i, Columns.Count).End(xlToLeft).Column
         
        Cells(i, 3 + j) = Cells(i, j) * 10
         
          If Cells(i, 3 + j).Value >= 80 Then '80以上の場合
                Cells(i, 3 + j).Interior.ColorIndex = 22 'ピンク
            Else
            End If
        Next j
    Next i
    
End Sub
 
Excelマクロ初心者です。
ご教示お願いします。

回答
投稿日時: 17/12/26 11:39:29
投稿者: WinArrow
投稿者のウェブサイトに移動

色で判断せずに
色設定時の条件と同じ条件で判断すればよいでしょう。
 
ColorIndexは、色そのものの値ではなく、色パレットの番号です。
色パレットは、環境によって任意に設定することができる。
そのため、色パレットの番号にsっ呈した色が、常に同じということはない。
 
他のPCで使うことを前提にするならば、↑のようなことを想定した配慮が必要です。

回答
投稿日時: 17/12/26 14:30:28
投稿者: 細雪

momo0717 さんの引用:
マクロの勉強を兼ねて、データ抽出のマクロを考えています。

とのことなので微力ながら協力を。
 
momo0717 さんの引用:

A〜B列に数値が入っており、C〜D列へ計算結果を入れ、その結果をもとに、セルへ色付けを行うマクロを作りました。

なるほど、セルの値が80以上ならピンクに塗る、ってヤツですね。OKです。
本題に入る前に、一つ。
計算結果はC:D列とのことですので、Cells(i, 2 + j) かな、と思うのですがどうでしょう?
 
 
 
さて、勉強中とのことですから、イミディエイトウインドウも使ってみましょう。
VBEを起動し、Ctrl+Gを押すとイミディエイトウインドウが出てきます。
ココに、まぁ何でもいいんですが、例えば
  Range("A1").value="Excel"
と打って、Enterキーを押してみると、A1セルに"Excel"と入力されるはずです。
こんな感じで、単発の構文確認などに使えます。
 
更にイミディエイトウインドウに例えば
  ? Range("A1").Value
と打ってみると・・今度はイミディエイトウインドウにA1セルの値が表示されるはずです。
このように、セルの値や状態、計算の結果などなど、「? なんとか」と打つことにより確認もできます。
 
さてさて、本題。
おっしゃる「ピンク(.ColorIndex = 22)に塗られたセル」にフォーカスを置き、
  ? Selection.Interior.Color
とイミディエイトウインドウに打って、Enterキーを押してみましょう。
すると「8421631」という数字が返ってきます。※環境によって違うかもしれませんが。
イミディエイトで「ドコのセル.Interior.Color」でセルの塗りつぶしを逆に確認できるわけです。
そんなわけで、おっしゃる「ピンク」を表す色コードが「8421631」であることが分かりました。
 
これを、If に渡して評価してもらいます。
ごく簡単に進行を考えていきます。
ただし、F:G列に対象を転記・・とのことですが、ココはちょっと端折ってF列だけに羅列していきます。
 
Dim i As Integer, j As Integer, k As Integer
    k = 1 ' 転記先開始位置を1行目にするために、変数kに1を代入
  For i = 3 To Cells(Rows.Count, 3).End(xlUp).Row ' 行の繰り返しを定義(C列を見ます)
        For j = 3 To 4 ' 列の繰り返しを定義(データはC:D列までなので、3から4)
            If Cells(i, j).Interior.color = 8421631 Then ' 塗りつぶし色がピンク(8421631)なら
                Cells(k, 6).Value = Cells(i, j).Value ' 対象セルをF列に転記
                k = k + 1 ' 転記先を次の行に移動
            End If
        Next j
    Next i
 
こんな感じで行けるかなぁ、と思います。
 
 
・・・あ、F列に羅列したいのではなくで、
例えばC4セルがピンクならF4セルに、D8セルがピンクならG8セルに・・
それぞれ対応して転記、ってことかな?
だとしたら、変数kは無しで、
  Cells(i, j + 3).Value = Cells(i, j).Value
ですね。
 
 
ちなみに、色を付ける際には .ColorIndex を使わずに
    Cells(i, 3 + j).Interior.Color = 8421631
    Cells(i, 3 + j).Interior.Color = RGB(255, 128, 128)
なんていう設定の仕方もありますよ。(上記2つは同じ色です。)
特に下側は使うことも多いかもしれません。
ワークシートで例えば「塗りつぶしの色⇒その他の色⇒ユーザー設定」の中をよく見てみると・・?
  R=赤、G=緑、B=青
であることが解りますね。
コレを順番に打ってやればOKです。
なお、上側は「BGRの順に16進数に置き換えて羅列、それを10進数に変換してやる」という
厄介な操作が必要ですので、特にこだわりが無いなら素直に後者を使うことをオススメします。
   ※例のピンクの場合。255=FF、128=80。
    なので、0x8080ff = 8421631 というわけです。
 
 
 
以上、長々と。
とりあえず、一助になれば。

回答
投稿日時: 17/12/26 14:38:22
投稿者: 細雪

追)連投失礼。
 
書き漏れましたが、
当然のことながら「色を塗る条件=抽出する条件」ですから、
流用してやるのがもちろん一番やりやすいですよ。
 
色で・・というのはなかなか採用しづらいやり方だと個人的には思います。
特に先の「.Interior.Color」で拾うやり方は条件付き書式には対応できないのでご注意くださいませ。

回答
投稿日時: 17/12/26 15:58:43
投稿者: WinArrow
投稿者のウェブサイトに移動

すみません、文章に入力ミスがありました。
 
再掲させていただいます、
 
色で判断せずに
色設定時の条件と同じ条件で判断すればよいでしょう。
  
ColorIndexは、色そのものの値ではなく、色パレットの番号です。
 色パレットは、環境によって任意に設定することができる。
そのため、色パレットの番号がどの環境でも同じ色ということはない。
  
他のPCで使うことを前提にするならば、↑のようなことを想定した配慮が必要です。
 
ところで、
データがA列とB列セルに入っているのだから
> For j = 1 To Cells(i, Columns.Count).End(xlToLeft).Column
を使うより
        For j = 1 To 2
の方が確実ではないですか?
計算結果を入れるせるは、細雪さんのご指摘通り。
 

投稿日時: 17/12/26 16:24:40
投稿者: momo0717

WinArrowさん、細雪さん
アドバイスありがとうございました。
無事完成できました。
勉強になりました。
改めまして、ありがとうございました。