• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:4つのセルを1つの塊り(マス)と捉えて塗潰す方法3)

4つのセルを1つの塊り(マス)と捉えて塗潰す方法

このQ&Aのポイント
  • 140個のセルを5マス×7マスに分けて、指定した数字に一致するマスを特定の色で塗潰す方法について教えてください。
  • マスとは4つのセルをまとめて1つとみなし、その中に一致した数字の数に応じて色を塗り潰します。
  • 具体的には、一致した数字が1個なら黄色、2個なら赤色、3個なら緑色、4個なら青色で塗り潰します。

質問者が選んだベストアンサー

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

こんばんは、 前回の回答では3個目は黄色に戻ってしまい、申し訳なかったです。m(_ _)m Sub Test5() Dim fnd As Range, R As Boolean, c As Boolean Dim adr As String, keyWord As String keyWord = Range("P1").Value Range("A1:N10").Interior.Color = xlNone Set fnd = Range("A1:N10").Find(What:=keyWord, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, MatchByte:=True) If fnd Is Nothing Then MsgBox keyWord & " は見つかりませんでした。", 48 Exit Sub End If adr = fnd.Address Do R = fnd.Row Mod 2 = 0 c = fnd.Column Mod 2 = 0 With fnd.Offset(R, c).Resize(2, 2).Interior If .Color = vbYellow Then .Color = vbRed ElseIf .Color = vbRed Then .Color = vbGreen ElseIf .Color = vbGreen Then .Color = vbBlue ElseIf .Color = vbWhite Then .Color = vbYellow End If End With Set fnd = Range("A1:N10").FindNext(fnd) Loop While adr <> fnd.Address End Sub

moguo4649
質問者

お礼

いつも回答頂きありがとうございます。 早速、教えて頂きありがとうござます。 前回の回答の動作には気が付きませんでした。 また質問を見かけたらよろしくお願いします。 丸投げですが・・・。

すると、全ての回答が全文表示されます。

関連するQ&A

専門家に質問してみよう