アプリ版:「スタンプのみでお礼する」機能のリリースについて

VBAで次のような条件を満たすように処理を行いたいと思いますが
上手い方法が分からずにいます。下の★マークのところで、
条件を複数選択できるようにしたいのですが、
スマートな方法はあるでしょうか。
なお、使用するのは自分自身だけです。

・選択した範囲のセルを走査して、セルの値の一部に特定の文字(ここでは HIT とします)が
 含まれた場合に、そのセルに色をつける。
・その際、次のように対象セルの周りのセルを同時に色付けするようにしたい。
 プロージャを実行する際に、オプションとして同時に任意に複数選択できるようにしたい。★
  1 対象セルに色付けする
  2 対象セルの上のセルに色付けする
  4 対象セルの下のセルに色付けする
  8 対象セルの右のセルに色付けする
  16 対象セルの左のセルに色付けする
 上記の 0,1,2,4,8 はこのQAの説明のために付けた番号なので、
 プログラミングでは別の番号や文字列で処理してよい

よろしくお願いします。

以下、自分なりに考えた方法

① 上で書いた1,2,4,8,16 のうち、実行したいものの番号を足し合わせた数を入力して処理する。
 たとえば、対象セルとその上のセルに色付けする場合は 1+2=3 と考え 3 を入力する。
 2進法を利用した方法なのですが、入力された数をVBA側で受け取ったあとの
 処理を簡単にかけずにいます。
 受け取った値 X を2で割って、その余り R1 が0なら~~、その余り R1 が1なら~~
 次に、X-R1 を2で割って、その余り R2 が 0 なら~~
 ・・・
② ユーザーフォームを使って、条件をえらぶチェックボックスなどを配置し、
 チェックボックスがチェックされたかどうかを判定して処理する。
 全部で最大 5 つの複数選択となるので、5 つのチェックボックスを配置する。
 IF~End IF 文を5回使って処理する。

など、考えられますが、ベテランの方はどのようにプログラミングするのでしょう。

質問者からの補足コメント

  • 質問文中に誤りがありました。
    誤  上記の 0,1,2,4,8 はこのQAの説明のために付けた番号なので、
    正  上記の 1,2,4,8,16 はこのQAの説明のために付けた番号なので、

      補足日時:2024/04/16 22:58

A 回答 (4件)

and を行うとビットの積が取得できます。


例えば、nに1+2=3が与えられたとき、
①ret= 1 and n
②ret= 2 and n
③ret= 4 and n
④ret= 8 and n
を行うと
① ret=1
② ret=2
③ ret=0
④ ret=0
となります。

以下は、実装例です。

Sub マクロ実行()

Dim n As Long
n = 1 + 2
If (1 And n) <> 0 Then
Debug.Print "1がON"
End If
If (2 And n) <> 0 Then
Debug.Print "2がON"
End If
If (4 And n) <> 0 Then
Debug.Print "4がON"
End If
If (8 And n) <> 0 Then
Debug.Print "8がON"
End If
End Sub

実行結果
1がON
2がON
    • good
    • 0
この回答へのお礼

回答ありがとうございます!

And によるビットの積、このようなシンプルな演算があると知りませんでした。複数の条件のAnd積は、1 TRUE と 0 FALSE のビットの積ということでしょうか。And 、、、よく使う演算子なのに、それがご回答のようなビット積であったなんて。目から鱗です。

お礼日時:2024/04/16 23:04

案③ 実行したいものの英字を連ねた文字列を入力して処理する



n = "cudrl"
If InStr(n, "c") > 0 Then 対象セルに色付け
If InStr(n, "u") > 0 Then 上のセルに色付け
If InStr(n, "d") > 0 Then 下のセルに色付け
If InStr(n, "r") > 0 Then 右のセルに色付け
If InStr(n, "l") > 0 Then 左のセルに色付け

参考)
https://learn.microsoft.com/ja-jp/office/vba/lan …
    • good
    • 0
この回答へのお礼

回答ありがとうございます。InStr関数による条件処理、こちらは、色付けしたいセルの場所が文字列で設定できるため、ユーザーインターフェースの視点でも1つの考え方の参考になります。

お礼日時:2024/04/16 23:17

こんにちは



そのままマッピングできるように配列などでデータを設定しておくと、ループ処理ができるので簡単そうに思います。
(5種類程度なら、個別に判定しても大差はないでしょうけれど・・)

VBAの場合は配列の設定が面倒ですが、以下では、ご質問文のままに相対座標を併せて定義しておく方法にしてみました。
ご参考にでもなれば。
※ 上下左右のセルが、シート外や想定範囲外になることは考慮していません。

Dim map As Variant
map = Array(Array(1, 0, 0), Array(2, -1, 0), _
Array(4, 1, 0), Array(8, 0, 1), Array(16, 0, -1))

Set c = Range("C4") ' [ 対象セル ]
opt = 8 ' [ オプション(1~31)]
col = vbRed ' [ 指定色 ]


For i = 0 To UBound(map)
If opt And map(i)(0) Then _
c.Offset(map(i)(1), map(i)(2)).Interior.Color = col
Next i
    • good
    • 1
この回答へのお礼

回答ありがとうございます。

Arrayの中にArrayを連ねることは考えたこともありませんでした。このArray内のArrayの用い方がとても賢く、初学者にはなかなか発想できない方法であると思います。この方法は、オプションの選択肢が多くなった場合でも、コードの記述量が増えず、非常に効率的な方法だと感じます。非常に参考になります。

お礼日時:2024/04/16 23:14

いろいろやり方はあるとは思いますが、私なら原始的に対象セルとその上下左右のセルに対して色づけを行います。



If cCell.Value = "HIT" Then
cx = -1
rx = -1
If cCell.Row = 1 Then rx = 0
If cCell.Column = 1 Then cx = 0
For rxi = rx To 1
For cxi = cx To 1
Cells(cCell.Row + rxi, cCell.Column).Interior.ThemeColor = xlThemeColorAccent4
Cells(cCell.Row, cCell.Column + cxi).Interior.ThemeColor = xlThemeColorAccent4
Next
Next
End If
    • good
    • 0
この回答へのお礼

回答ありがとうございます。対象のセルを基準に -1 0 1のFor~Nextループ、考える参考になります。

お礼日時:2024/04/16 23:07

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A