「教えて!ピックアップ」リリース!

VBA勉強中で分からないながら、背景色のある/なしを判断して列によって異なる文字を表示させる勤務表を作成中です。背景色はⅠ.Ⅱ.Ⅲ棟の使用状況(使用あり=黄色)をcolorcount関数でカウントして条件付き書式で設定してます。コードが正しいのかも分かりませんし、かなり遅いですがなんとかイメージ通りには動作しました。
今は範囲設定はセルで指定していますが、これを「今日の日付から2ヶ月先(60回)」までを範囲としたい場合の処理方法を知りたくて質問しました。
ご回答、宜しくお願いします。
(勤務表の日付は1年分続いていて、1週間に1回くらいの更新を予定しています)

Sub 練習用()

Dim WSheet As Worksheet

Dim l As Range
Dim c As Range
Dim r As Range
Dim s As Range

Set WSheet = ThisWorkbook.Worksheets("作成中")

For Each l In Range("R3:R183,W3:W183,AB3:AB183,AG3:AG183")
If l.DisplayFormat.Interior.Color = RGB(226, 239, 218) And l = "Ⅰ棟" Then
End If
'Else
If l.DisplayFormat.Interior.Color = RGB(226, 239, 218) And l = "" Then
l = "Ⅰ棟"
End If
'Else
If l.DisplayFormat.Interior.Color <> RGB(226, 239, 218) And l = "Ⅰ棟" Then
l = ""
End If
'Else
If l.DisplayFormat.Interior.Color = RGB(226, 239, 218) And l <> "Ⅰ棟" Then
End If
'Else
If l.DisplayFormat.Interior.Color <> RGB(226, 239, 218) And l <> "Ⅰ棟" Then
End If
Next l

For Each c In Range("S3:S183,X3:X183,AC3:AC183,AH3:AH183")
If c.DisplayFormat.Interior.Color = RGB(226, 239, 218) And c = "Ⅱ-2F" Then
End If
'Else
If c.DisplayFormat.Interior.Color = RGB(226, 239, 218) And c = "" Then
c = "Ⅱ-2F"
End If
'Else
If c.DisplayFormat.Interior.Color <> RGB(226, 239, 218) And c = "Ⅱ-2F" Then
c = ""
End If
'Else
If c.DisplayFormat.Interior.Color = RGB(226, 239, 218) And c <> "Ⅱ-2F" Then
End If
'Else
If c.DisplayFormat.Interior.Color <> RGB(226, 239, 218) And c <> "Ⅱ-2F" Then
End If
Next c

For Each r In Range("T3:T183,Y3:Y183,AD3:AD183,AI3:AI183")
If r.DisplayFormat.Interior.Color = RGB(226, 239, 218) And r = "Ⅱ-3F" Then
End If
'Else
If r.DisplayFormat.Interior.Color = RGB(226, 239, 218) And r = "" Then
r = "Ⅱ-3F"
End If
'Else
If r.DisplayFormat.Interior.Color <> RGB(226, 239, 218) And r = "Ⅱ-3F" Then
r = ""
End If
'Else
If r.DisplayFormat.Interior.Color = RGB(226, 239, 218) And r <> "Ⅱ-3F" Then
End If
'Else
If r.DisplayFormat.Interior.Color <> RGB(226, 239, 218) And r <> "Ⅱ-3F" Then
End If
Next r

For Each s In Range("U3:U183,Z3:Z183,AE3:AE183,AJ3:AJ183")
If s.DisplayFormat.Interior.Color = RGB(226, 239, 218) And s = "Ⅲ棟" Then
End If
'Else
If s.DisplayFormat.Interior.Color = RGB(226, 239, 218) And s = "" Then
s = "Ⅲ棟"
End If
'Else
If s.DisplayFormat.Interior.Color <> RGB(226, 239, 218) And s = "Ⅲ棟" Then
s = ""
End If
'Else
If s.DisplayFormat.Interior.Color = RGB(226, 239, 218) And s <> "Ⅲ棟" Then
End If
'Else
If s.DisplayFormat.Interior.Color <> RGB(226, 239, 218) And s <> "MS" Then
End If

Next s
MsgBox ("更新が完了しました")

End Sub

「VBAの繰り返し処理について教えてくださ」の質問画像

A 回答 (3件)

こんにちは



せっかくの画像ですがぼやけて識別できないですし、シートの説明や処理内容の説明もないので、ほとんどわからないですね。
コードを読んで解読しろって意味なのかも知れませんけれど、冗長だし実際には意味の無い記述が多いので、どこまでが本当の意図なのかわかりかねます。
際には、実行する際に内容が変わるのでコードを書き直してから実行するためにこのような記述にしてあるということでしょうか?
実効性のある判断は2つに対して5回の判断をしていますし、(多分)セル結合しているようなので、意味の無いセルに対しても不要な判断を繰り返すようになっていると思われます。
(実質的に必要な回数に対して、約8倍近く不要な処理をしているように見えます)
また、これらを一般化して、まとめてしまっても良いのか、悪いのかもわかりません。

>「今日の日付から2ヶ月先(60回)」までを範囲としたい場合の
>処理方法を知りたくて質問しました。
日付がどこにあるのかも不明ですけれど(もしかするとC列かな?)、日付を順に見て行って、条件に合致した行だけ処理を行うように制御すれば良さそうには思いますが、いかんせんなさりたいことが明確になっていないので明言できません。


何が可変で何が固定なのかもよくわかりませんけれど、ひとまず、処理をまとめてしまっても良いものとして、当たるも八卦で勝手に解釈してみました。
勝手に、以下と仮定しています。
 ・条件判断のための日付はC列とする。
 ・C列の日付はシリアル値(=エクセルの日付型の値)である
 ・対象範囲は3行目以降、最終行までとする
 ・C列およびR:AJ列の処理対象は、全て3行ごとの結合セルとなっている
 ・R:AJ列の処理内容は以下
   背景色が指定色で、かつ、セルが空白なら指定文字を入力
   背景色が指定色でなく、かつ、セルが指定文字ならセルをクリア
(指定色は薄緑(=RGB(226, 239, 218))、指定文字は列によって異なる(=Ⅰ棟、Ⅲ棟など))

※ 当たりではない可能性が高そうですが、まったくの的外れでもないと思いますので、適当に修正してみてください。

Sub Q13075275()
Dim mRow As Long, r As Long
Dim i As Long, col As Long
Dim dS As Date, dE As Date
Dim c As Range, cFlag As Boolean
Dim dateV, tText

tText = Array("Ⅰ棟", "Ⅱ-2F", "Ⅱ-3F", "Ⅲ棟")
dS = Date
dE = dS + 60

mRow = Cells(Rows.Count, 3).End(xlUp).Row
If mRow < 3 Then Exit Sub
dateV = Cells(3, 3).Resize(mRow - 2).Value

For r = 1 To UBound(dateV) Step 3
If dS <= dateV(r, 1) And dateV(r, 1) <= dE Then

For col = 0 To 15 Step 5
For i = 0 To 3
Set c = Cells(r + 2, col + i + 18)
cFlag = c.DisplayFormat.Interior.Color = RGB(226, 239, 218)
If cFlag And c.Value = "" Then
c.Value = tText(i)
ElseIf Not cFlag And c.Text = tText(i) Then
c.Value = ""
End If
Next i
Next col

End If
Next r
End Sub
    • good
    • 2

あと書き漏れましたがIf文で結局何もしないのなら、その個所は書かない方がコードも短く出来るかと。

    • good
    • 1

知恵袋みたいに添付画像を拡大表示できるサイトを利用されては?

    • good
    • 1
この回答へのお礼

ご回答、ありがとうございます。
参考にします。

お礼日時:2022/08/07 20:46

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

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


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

人気Q&Aランキング