マクロで作業をもっと楽にしたい

2019/06/16 08:53

（シート名は上から　分析、分析 (2)、分析 (3)としています）

上の3つのミニロト出現表シートでのブロック分けしたところの番号未出現部分を灰色に塗りつぶす時に、該当セル部分をマウスで指定後マクロで実行していましたが面倒でした。（マウスで指定するのは手動なので余り意味のないマクロｗ）

そこで下のようにマクロを新しく作ってみました。
該当セルの1セル指定後マクロでブロックの複数セルの塗りつぶします。

セルの列範囲は10から40でシート毎にブロック分け範囲が違うのでシート名毎に
塗つぶす範囲を指定します。（分析、分析 (2)、分析 (3)　各シート）

Sub B_Hset() '未出現ブロック塗りつぶしマクロ

Dim retu, gyou, As Integer

Dim sheetName As String

sheetName = ActiveSheet.Name　’作業時のシート名を変数に格納する

　 retu = ActiveCell.Column
   　 gyou = ActiveCell.Row

　’3つのシート名毎のブロック範囲指定
If sheetName = "分析" Then
    If retu >= 10 And retu <= 18 Then
       Range(Cells(gyou, 10), Cells(gyou, 18)).Select

    ElseIf retu >= 19 And retu <= 28 Then
       Range(Cells(gyou, 19), Cells(gyou, 28)).Select

    ElseIf retu >= 29 And retu <= 38 Then
       Range(Cells(gyou, 29), Cells(gyou, 38)).Select

    ElseIf retu >= 39 And retu <= 40 Then
       Range(Cells(gyou, 39), Cells(gyou, 40)).Select

    End If


ElseIf sheetName = "分析 (2)" Then

    If retu >= 10 And retu <= 14 Then
       Range(Cells(gyou, 10), Cells(gyou, 14)).Select

    ElseIf retu >= 15 And retu <= 19 Then
       Range(Cells(gyou, 15), Cells(gyou, 19)).Select

    ElseIf retu >= 20 And retu <= 24 Then
       Range(Cells(gyou, 20), Cells(gyou, 24)).Select

    ElseIf retu >= 25 And retu <= 29 Then
       Range(Cells(gyou, 25), Cells(gyou, 29)).Select

    ElseIf retu >= 30 And retu <= 34 Then
       Range(Cells(gyou, 30), Cells(gyou, 34)).Select

    ElseIf retu >= 35 And retu <= 40 Then
       Range(Cells(gyou, 35), Cells(gyou, 40)).Select

    End If

ElseIf sheetName = "分析 (3)" Then
    If retu >= 10 And retu <= 15 Then
       Range(Cells(gyou, 10), Cells(gyou, 15)).Select

    ElseIf retu >= 16 And retu <= 21 Then
       Range(Cells(gyou, 16), Cells(gyou, 21)).Select

    ElseIf retu >= 22 And retu <= 27 Then
       Range(Cells(gyou, 22), Cells(gyou, 27)).Select

    ElseIf retu >= 28 And retu <= 33 Then
       Range(Cells(gyou, 28), Cells(gyou, 33)).Select

    ElseIf retu >= 34 And retu <= 40 Then
       Range(Cells(gyou, 34), Cells(gyou, 40)).Select

    End If

End If

    With Selection.Interior　’塗つぶす（以前のマクロはこれだけ）
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
End Sub