ここから本文です

特定条件下でのセル個数をカウントするマクロに関しての質問です。

har********さん

2018/4/422:15:28

特定条件下でのセル個数をカウントするマクロに関しての質問です。

Sub test()
Dim myRng As Range
Dim cnt As Long, i As Long
Set myRng = ActiveCell
If (myRng.Row <= 16) Then Exit Sub
With ActiveSheet
cnt = 0
For i = myRng.Row To 16 Step -11
With .Cells(i - 11, myRng.Column)
Select Case .Interior.ColorIndex
Case 4
If (.Value = myRng.Value) Then Exit For
Case 33, 38
cnt = cnt + 1
End Select
End With
Next i
If (i < 16) Then cnt = 0
.Range("F2").Value = cnt
End With
End Sub
上記マクロの説明ですが、①アクティブセルから上方向に11個刻みでループし、11個刻み上に存在し、アクティブセルと同じ数字が入力され、しかも緑(4)で着色された直近のセルを探す。これが12行目までの内容だと思います。
②13行目以下の内容は、アクティブセルと①で探し当てたセルの間、しかも、あくまでもアクティブセルから上方向に11個刻みで存在する青(33)と紫(38)の合計個数を("F2")に入力する、こんな内容です。
以前も同じ内容の質問で解決して頂いたんですが、色を変えたり追加したりしたら不都合な事象が発生し、再度質問した次第です。
質問ですが、上記マクロの11行目のCase 4の色を変更して、Case 33,38にしましたら、説明②のセル(Case 33, 38)が存在するのに認識されずに("F2")には0が入力されてしまいます。
他の色も認識されないのかと思い、試しに13行目を Case 33, 38,6と黄色(6)を追加してみましたら黄色だけ認識され、黄色のセル個数だけ入力されました。
11行目をCase 33, 38にしても、13行目のCase 33, 38が認識される様にして頂けませんか。
11行目と13行目の色を33,38に限らず、変えたり、追加したりして使いたいんです。
数日前から自分で色々試してみましたが、分かりませんでした。
よろしくお願い致します。Excel2016です。

閲覧数:
147
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

tra********さん

2018/4/501:30:20

1)
>アクティブセルと同じ数字が入力され、
>しかも緑(4)で着色された直近のセルを探す。
If (.Value = myRng.Value) Then Exit For
なので、探すのではなく、見つかったら検索の繰り返しを中止する、ですね。

2)
>Case 33,38にしましたら、説明②のセル(Case 33, 38)が
>存在するのに認識されず
①の条件(1つ目のCase文に書かれたもの)に合致するものは、2つ目以降のCase文の条件は検査されません。1つのSelect文と対になっているCase文は、上から順に検査され、検査条件を満たせば、以降のCase文の条件は検査されません。
なので、Case文に同一条件が書かれた場合は1つ目のCase文しか有効になりません。

3)
>11行目をCase 33, 38にしても、
>13行目のCase 33, 38が認識される様にして頂けませんか。
以上のようにSelect~Caseを使う限り無理。
条件が2つならIF文に書き換えですが、①と②の条件が同じという状況で違う処理を行うということ自体理解しがたいのですが。。。。
なにをやりたいのか詳しい説明が必要に思いませんか?

  • tra********さん

    2018/4/501:46:17

    1つヒント。
    Or条件は、配列化するとコードが簡略化できます。
    A1セルの背景色が3色のうちどれかになっているかチェックしてます。

    Sub sample()
    Dim xCol, i
    xCol = Array(33, 38, 6)
    i = Application.Match(Range("A1").Interior.ColorIndex, xCol, 0)
    If IsError(i) Then
    MsgBox "対象外"
    Else
    MsgBox "対象"
    End If
    End Sub

  • その他の返信(4件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2018/4/6 13:59:14

質問文が下手で上手く伝える事が出来ず、大変お手数お掛けしてしまいました。
今回頂いた回答は素人の自分には難しくて、アレンジしたりは出来そうにも有りませんが、使わせて頂きます。
今回は本当にありがとう御座いました。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる