VBAで作業の効率化をしたいのですが

画像

Excel | Visual Basic115閲覧xmlns="http://www.w3.org/2000/svg">100

ベストアンサー

2
画像

2人がナイス!しています

ThanksImg質問者からのお礼コメント

丁寧な対応ありがとうございます!

お礼日時:4/6 10:09

その他の回答(2件)

0

1つ1つ数えるのはいかにも低速に見えます。 Sub sample() Dim xRow As Range, xAre As Range Const cOff As String = "非番" Application.ScreenUpdating = False With Range("A1").CurrentRegion With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1) .Replace What:=cOff, Replacement:="", LookAt:=xlWhole For Each xRow In .Rows If Application.CountBlank(xRow) <> xRow.Cells.Count Then For Each xAre In xRow.SpecialCells(xlCellTypeConstants).Areas With xAre If .Cells.Count > 4 Then .Font.Underline = xlUnderlineStyleDouble .Font.Color = rgbRed ElseIf .Cells.Count > 3 Then .Font.Underline = xlUnderlineStyleSingle .Font.Color = rgbRed End If End With Next xAre End If Next xRow .SpecialCells(xlCellTypeBlanks).Value = cOff End With End With Application.ScreenUpdating = True End Sub

0

これでよかろう? 一応簡単に動作チェックはしてみた アンダーラインの描き方が分からないからセルの色で代用してみた VBAの質問をするなら、どの画面に打ち込んで、 どうやって実行させるのかは知ってから質問するのが常識 Dim Cnt ' 縦列のチェック(セル2~6) For y = 2 To 6 ' 1行が終わるごとにカウンターをリセット Cnt = 0 ' 横列をチェック(セルB~H) For x = 2 To 8 If Cells(y, x) = "日勤" Then Cnt = Cnt + 1 ' 日勤を見つけたらカウントする If Cells(y, x) = "中勤" Then Cnt = Cnt + 1 ' 中勤を見つけたらカウントする If Cells(y, x) = "非番" Then Cnt = 0 ' 非番を見つけたらカウンタをリセットする ' カウント回数が4回なら(日勤・中勤が4連続だったら) If Cnt = 4 Then ' 前3つと現在位置の合計4つ分ほど塗りつぶす For z = x - 3 To x Cells(y, z).Select ' 塗りつぶす場所を選択 Selection.Interior.ColorIndex = 6 ' 黄色 Selection.Interior.Pattern = xlSolid ' 塗りつぶし Next End If ' カウント回数が5回以上なら(日勤・中勤が5連続以上だったら) If Cnt >= 5 Then ' 前4つと現在位置の合計5つ分ほど塗りつぶす For z = x - 4 To x Cells(y, z).Select ' 塗りつぶす場所を選択 Selection.Interior.ColorIndex = 3 ' 赤色 Selection.Interior.Pattern = xlSolid ' 塗りつぶし Next End If Next Next