[[20200514132156]]　『条件（セル色）に合うものを見つける（抽出）方法』（ｐｐｐ）　ページの最後に飛ぶ

『条件（セル色）に合うものを見つける（抽出）方法』（ｐｐｐ）

　　Ａ　Ｂ　Ｃ　Ｄ
1行 3　4　 2　 1
2行 2 1 3 4 ←データ
3行 4 2 3 2

4行 1-4
5行 2-3　　　　　　　←結果
6行 2-4

1行ごとにセルに色が付いた数字を抽出したいのですが上手くできません。
宜しくお願いします。

1行　1と4にセル色（黄色）が付いています。
2行　2と3にセル色（黄色）が付いています。
3行　2と4にセル色（黄色）が付いています。

＜使用 Excel：unknown、使用 OS：Windows10 ＞

 シンプルに見える質問ですね。。

 実際にそうなのかちょっと不安。
 　列数は4列限定ですか？
 　黄色だけの話なんですか？
 　データは数値型のみなんですか？
 　データは１桁だけなんですか？
 　データ間に重複はないんですか？

（半平太） 2020/05/14(木) 14:46

お世話にになります。

1,列数８列です。

2,黄色というこだわりはありません。色が付いた分です。例で黄色としました。

3,データは数値のみです。

4,データは１桁のみです。

5,１行目に1～8の数字での中で色が付いた数字（セル色）を抽出したい。（普通は２個、多くて３個はセル色がつきます）
例、１行目に1と４と５にセル色がついていたら１－４、１－５と表示させたい（結果）
1と4しかセル色がついていない場合は１－４と表示させたいのです。（結果）

宜しくお願いします。

（ｐｐｐ） 2020/05/14(木) 18:10

セル色は１色です。
（ｐｐｐ） 2020/05/14(木) 18:12

 後記マクロを標準モジュールに貼り付けて、

 I1セルに =CellsColored(A1:H1)

 下にコピー

 <結果図>
  行  _A_  _B_  _C_  _D_   E    F   _G_  _H_   I 
   1   3    4    2    1                       1-4
   2   2    1    3    4                       2-3
   3   4    2    3    2                       2-4

 Function CellsColored(Scope As Range)
     Dim r
     Dim RW As Long, CL As Long
     Dim buf, Pos

     Application.Volatile

     With Scope
         ReDim r(1 To .Rows.Count, 1 To .Columns.Count)

         For RW = 1 To UBound(r)
             For CL = 1 To UBound(r, 2)
                 r(RW, CL) = IIf(.Cells(RW, CL).Interior.Color = 16777215, 10, .Cells(RW, CL).Value)
             Next CL
         Next RW
     End With

     Pos = Application.Small(r, [column(A1:H1)])
     buf = Pos(1) & "-" & Pos(2) & "、" & Pos(1) & "-" & Pos(3)

     If Pos(3) < 9 Then
         CellsColored = buf
     ElseIf Pos(2) < 9 Then
         CellsColored = Left(buf, 3)
     ElseIf Pos(1) < 9 Then
         CellsColored = Left(buf, 1)
     End If

 End Function

（半平太） 2020/05/14(木) 20:20

おかげさまで出来ました。感謝の気持ちでいっぱいです。有難うございました。
（ppp） 2020/05/14(木) 22:50

コメント返信：

[ 一覧(最新更新順) ]

[[20200514132156]] 『条件（セル色）に合うものを見つける（抽出）方法』（ｐｐｐ） ページの最後に飛ぶ

[[20200514132156]]　『条件（セル色）に合うものを見つける（抽出）方法』（ｐｐｐ）　ページの最後に飛ぶ